;FOCAL-11, VERSION B2

;BY RICK MERRILL

;COPYRIGHT@ 1970,1971 BY
;DIGITAL EQUIPMENT CORP, MAYNARD, MASS.



;DOCUMENTATION NOTES:
;DOUBLE QUOTE MARKS DENOTE SEMI-INSTRUCTION MODULES
;(X) MEANS THE CONTENT-OF-X.
;ASTERISKS DENOTE COMMAND MODULES.
;"C.R."MEANS "CARRIAGE RETURN".
;SINGLE QUOTE MARKS DENOTE A SUBROUTINE.
;EDITS BY JUDY SMITH AND GAIL BURKE.


;THIS DOCUMENT IS PROPRIETARY INFORMATION.

;ASSIGNMENTS OF REGISTERS


;AS USED GENERALLY
TEMP=%0		;SCRATCH
AC=%1		;ACCUMULATOR
PTR=%2		;VARIABLE POINTER
AXOUT=%3	;TEXT READER
CHAR=%4		;CHARACTER
R5=%5		;EXCEPTIONAL USE REGISTER AND RUBOUT PROTECTION

SP=%6		;STACK POINTER
PC=%7		;PROGRAM COUNTER PDP-11

;AS USED BY OUTPUT CONVERSION
P=TEMP		;PLACES BEFORE "."
AC=AC		;TOTAL NO. OF DIGITS.
E=PTR		;NO. OF INTEGER DIGITS
F=AXOUT		;TOTAL NO. OF PLACES.
CHAR=CHAR	;NO. OF DECIMAL POINTS
R5=R5		;SCRATCH


;AS USED BY EMT'S
TEMP=TEMP	;SCRATCH
AC=AC		;INPUT EXP;MAY CONTAIN OP-CODES
BH=PTR		;FLAC HORD;MAY CONTAIN ADDRESS
BL=AXOUT	;FLAC LORD;MAY BE NEED BY FREAD
AH=CHAR		;INPUT HORD;MAY BE NEEDED BY FREAD
AL=R5		;INPUT LORD


ONE=200		;SWITCH ASSIGNMENTS
ALL=1
NALPHA=20	;0=TERMINATE ON ASCII CODES
		;1=TERMINATE ON ;;C.R.ALSO

CR=216		;INTERNAL CODE
CRLF=05015	;FOR USE IN "PRINT2, CRLF"

TKS=177560
PRS=177550
TPS=177564
LPS=177514
PPS=177554
STATUS=177776

BEGIN=1100	;BOTTOM OF STACK
;MAIN VECTORS

.=0		;RESERVED FOR MANUAL RESTART VECTOR
	JMP  @#INIT2
;.=4		;ERROR TRAP VECTOR: STACK OVERFLOW TRAP
	STACKO
	400
;.=10		;RESERVED INST
	STACKO
	400
;.=14		;ODT
	STACKO
	400
;.=20		;IOT
DELETE=IOT	;REMOVE A LINE OF TEXT
	XDELET
	340
;.=24		;PWR-FAIL/AUTO-RESTART
	PWRDWN
	340
;.=30		;EMT
	FEMT
	340
;.=34		;TRAP
	TRAPH
	340
;.=40		;SYSTEM VECTORS
.=60
	KINT
KIN:	0
;.=70		;PR+PP-?
;.=100		;CLOCK OPTION


		;OTHER VECTORS?

;.=200		;LINE PRINTER
		;PATCH AREA



.=BEGIN		;FUNCTION TABLE BACKS INTO STACK AREA.



;LIST OF FUNCTION ADDRESSES AND NAMES.


	0		;END-OF-LIST MARKER.
.MACR	FOO
	XDYS		;DIS	-DISPLAY AND INTENSIFY
	13567
	ATN		;ATN	-ARC TANGENT
	13456
	FEXP		;EXP	-EXPONENTIAL FUNCTIONS
	13600
	FLOG		;LOG	-LOGARITHM
	13703
	ERROR5		;COM	-COMMUNICATIONS
	13471
.ENDM
	XABS		;ABS	-ABSOLUTE VALUE
	13353
	XSGN		;SGN	-SIGN PART
	14032
	XEX		;X	-EXPERIMENTAL
	560
	XADC		;ADC	-READ ANALOG TO DIGITAL CONVERTER
	13343
	XFNEW		;NEW	-USER DEFINED NEW FUNCTION
	13713
	XCHR		;CHR	-INPUT/OUTPUT OF CHARACTER DATA
	13442
	XRAN		;RAN	-RANDOM NUMBER
	13762
	XSQT		;SQT	-SQUARE ROOT
	14110
	FSIN		;SIN	-TRIG FUNCTIONS
	14042
	FCOS		;COS	-COSINE
	13477
	XITR		;ITR	-INTEGER PART
	13662


FNTABL=.+2	;SPECIAL TOPSY-TURVEY TABLE.
;FUNCTION TABLE BACKS INTO STACK AREA.
;HASH CODE IS FORMED FROM 7-BIT ASCII WITH PLACE VALUE OF 4^N
;E.G. FX=F*4+X=106*4+130=560

JMS=104400-.+200

TRINTAB=.			;TRAP-INTERPRETIVE TABLE

SORTJ  = JMS +.		;SORT AND BRANCH ON (CHAR)
	SORTB
SORTC  = JMS +.		;SORT CHAR
	SORTD
PRINTC = JMS +.		;PRINT CHAR-S
	OUT
READC  = JMS +.		;READ DATA INTO CHAR AND PRINT IT-S
	CHIN
OUTCH  = JMS +.		;OUTPUT TO A DEVICE
	XOUT
INCH   = JMS +.		;INPUT FROM A DEVICE
	XI33
GETC   = JMS +.		;UNPACK A CHARACTER-S
	GETX
PACKC  = JMS +.		;SAVE A CHARACTER -S
	PACKX
TESTC  = JMS +.		;RETURNS ON (CHAR)=TERM;NUMBER;FUNCTION;RETURN-ON-LETTER
	TESTX
GETLN  = JMS +.		;UNPACK AND FORM A LINENUMBER
	GETLNX
FINDLN = JMS +.		;SEARCH FOR A GIVEN LINE
	FINDX
PRNTLN = JMS +.		;PRINT (LINENO)
	XPRNTL
COPYLN = JMS +.		;READ NEXT LINE NUMBER
	COPYLX
START  = JMS +.		;RETURN TO COMMAND/INPUT MODE
	STARTX
SPNOR  = JMS +.		;IGNORE SPACES-S
	SPNORX
ERASEV = JMS +.		;ERASE AND SET VARIABLES.
	ERVX
PRINT2 = JMS +.		;PRINT TWO CHARACTERS
	PRIN2A
DIGTST = JMS +.		;TEST FOR A DIGIT OF INDICATED PLACE VALUE
	DIGTSA
PARTST = JMS +.		;CHECK FOR PARENTHESIS MATCH.
	PARTSA
GROOVY = JMS +.		;COMPARE GROUP NOS.
	GROVX
GTRY   = JMS +.		;LOOK FOR ENTRY IN SYMBOL LIST.
	GTRYX
GSWIPE = JMS +.		;SWIPE A ZERO VARIABLE
	GSWIPX
SKPLPR = JMS +.		;SKIP IF (CHAR) IS A LEFT PARENS.
	XTSTLP
SKPNON = JMS +.		;SKIP IF NOT A NUMBER
	SKPNOX
TASK   = JMS +.		;DO FORMAT CONTROLS FOR *ASK*TYPE*
	TASKX
EVAL.X = JMS +.		;"PUSHJ EVAL-2"
	EVALUX


JMS+.	;SPARE FOR DEBUGGING.
JMS+.	;SPARE FOR PATCHES.






.MACR ERROR NO.
	104400+201+NO.+NO.  ; YOU SHOULD KNOW BETTER!
.ENDM



.MACR	PUSHJ	ARG
	JSR	PC,	ARG
.ENDM



OPEN=024646	;CMP -(SP), -(SP)

CLOSE=022626	;CMP (SP)+, (SP)+

PRINT=104400	;TRAP+(0,1,177) FOR ASCII CODES.

POPJ=207	;RTS PC



;LISTS TO BE TESTED BY
;"SORTJ" AND "SORTC"

ILIST:	IF1	;,
	PROCESS	;;
	PC1	;CR

FLIST2:	FLIMIT		;,=STANDARD
	FINFIN		;;=SHORT
	FINERR		;CR=DUMB

FLIST1:	FINCR		;,=STANDARD FORMAT
	TPR		;;=SET;PLUS...GO TO PROCESS
	TPR1		;C.R.=SET COMMAND---GO TO PC1

ATLIST=.		;ASK-TYPE CONTROL CHARACTER TABLE
	TINTR		;%-FORMAT DELIMITER
	TQUOT		;"-LITERAL DELIMITER
	TCRLF		;!-CARRIAGE RETURN AND LINE FEED
	TCRLF2		;#-CARRIAGE RETURN ONLY
	TDUMP		;$-DUMP THE SYMBOL TABLE CONTENTS
	TASK4		;SP-TERMINATOR FOR NAMES
	TASK4		;,-TERMINATOR FOR EXPRESSIONS
	TPR		;;-TERMINATOR FOR COMMANDS
	TPR1		;C.R.-TERMINATOR FOR STRINGS

;$-FOR 'TDUMP' TERMINATES THE COMMAND!

INLIST=.		;INPUT DATA CONTROL CODES.
	AGO		;ALTMODE=LEAVE RESULT
	ASPACE		;SPACE=CHECK FOR TERMINATOR FUNCTION
	ARO		;RUB OUT
	ATAKE		;IGNORE LINE FEEDS

SRNLST=.		;'MODIFY' CONTROL CHARACTER TABLE
	SCHAR		;F.F.=CONTINUE
	SCONT		;BELL=CHANGE SEARCH CHARACTER
	SCONL		;L.F.=FINISH THE LINE AS BEFORE.

LISTGO=.
	SRETN		;C.R.=END THE LINE HERE AS IS.
	SFOUND		;CHAR=SEARCH CHARACTER

COMLST=.		;COMMAND DECODING LIST
	ASK		;ASK	 -DEMANDE
	ERRORC
	PC1		;COMMENT -COMMENTE
	DO		;DO	 -FAIZ
	ERASE		;ERASE	 -BIFFE
	FOR		;FOR	 -QUAND
	GOTO		;GOTO	 -VA
	ERRORC
	IF		;IF	 -SI
	ERRORC
	ERRORC
	ERRORC		;LIBRARY -ENTERPOSE
	MODIFY		;MODIFY	 -MODIFIE
	ERRORC
	PROGIO		;OPERATE -?
	ERRORC
	STARTX		;QUIT	 -ARRETE
	RETURN		;RETURN	 -RETOURNE
	SET		;SET	 -ORGANIZE
	TYPE		;TYPE	 -TAPE
	ERRORC
	ERRORC
	WRITE		;WRITE	 -INSCRIS
	XECUTE		;XECUTE	 -?
TERMS=.		;TERMINATOR TABLE FOR 'EVAL' AND 'GETVAR'
.BYTE	040	;SPACE  0 - (ASCII CODES)
.BYTE	053	;+	1
.BYTE	055	;-	2
.BYTE	057	;/	3
.BYTE	052	;*	4
.BYTE	136	;UP ARR 5
.BYTE	050	;(	6 L-PARS
.BYTE	133	;[	7
.BYTE	074	;<	10
.BYTE	051	;)	11 R-PARS
.BYTE	135	;]	12
.BYTE	076	;>	13
.BYTE	054	;,	14
.BYTE	073	;;	15
.BYTE	015	;C.R.	16
.BYTE	075	;=	17 TO END GETARG FROM 'SET'
.BYTE	000

ALIST=.	;ASK.TYPE LIST OF CONTROLS (INTERNAL CODES)
.BYTE	045	;%
.BYTE	042	;"
.BYTE	041	;!
.BYTE	043	;#
.BYTE	044	;$
.BYTE	200	;SPACE

TLIST=.		;TERMINATORS (INTERNAL CODES)
.BYTE	214	;,
.BYTE	215	;;
.BYTE	216	;CARRIAGE RETURN
.BYTE	000	;END LIST

SPECIAL=.
.BYTE	175	;ALTMODE
.BYTE	200	;SPACE

ECHOLST=.	;(ASCII)
.BYTE	177	;RUB-OUT (R.O.)
.BYTE	012	;LINE FEED (L.F.)
.BYTE	000	;END LIST

LIST6=.
.BYTE	014	;CONTROL-FORM
.BYTE	007	;CONTROL-BELL
.BYTE	012	;LINE FEED

LIST3=.
.BYTE	216		;RETURN

;VARIABLE STORAGE AREA:******

.BYTE	-1		;SEARCH CHARACTER-**
.BYTE	000		;END OF LIST
.EVEN
LSPR:	0+.		;RANDOM NUMBER LOW PART.
AXIN:	0+.		;STORAGE INDEX POINTER
PCF:	FLTZER-2	;PROGRAM COUNTER FOR FOCAL = START SAVE AREA
THISLN:	0+.		;LINE POINTER FROM 'FINDLN'
DEBG:	1		;(ON-OFF, ENABLE) 0,0 = TRACE.
FLARG:	0+.,0+.		;RESULT STORAGE
			;FLOATING ACCUMULATOR
BE:	0+.		;F.A.
HORD:	0+.		;HIGH ORDER PART
LORD:	0+.		;LOW ORDER PART
			;
LINENO:	0+.		;LINE NUMBER READ BY GETLN
FISW:	04012		;OUTPUT FORMAT %8.04.
SWITCH=.+1		;"NAGSW" ETC.
LINCNT:	80.		;WIDTH OF TTY LINE
INDEV:	TKS		;POINTER TO IN. DEV STATUS
OUTDEV:	TPS		;POINTER TO OUT. DEV STATUS. = END SAVE AREA
WHOOPS:	000		;POWER FAIL/AUTO-RESTART SWITCH
BUFR:	BUFBEG		;NEXT LOCATION IN BUFFER = LAST LOCATION USED.
STARTV:	BUFBEG+80.	;BEGINNING OF BUFFER AREA
TOP:	BUFBEG		;BEGINNING OF TEXT BUFFER AREA.
BOTTOM:	17500		;END OF ALL CORE (REALLY A CONSTANT)
			;
CFRS:	-.-2		;TEXT DATA POINTER
	000		;LINE ZERO.
.ASCII "C:FOCAL-11,PRELIM";VERSION IDENTIFIER
.BYTE	216
.EVEN			;A PURE PROCEEDURE FROM HERE ON!


;STACK OVERFLOW HANDLER

STACKO:	MOV	#BEGIN,SP		;RESET STACK IMMEDIATELY!
	ERROR	9.			;THEN PRODUCE DIAGNOSTIC


;TRAP HANDLER

;"PRINT"	0,1,177
;TRAP		200,2,376
;"ERROR"	201,2,377

TRAPH:	MOV	2(SP),	-2(SP)		;KEEP THE STATUS-QUO FOR FIVE INSTRUCTIONS!
	MOV	R5,	2(SP)		;SAVE R5 ONTO STACK OVER STATUS BITS.
	MOV	@SP,	R5		;PICKUP THE RETURN ADDRESS.
	MOV	-2(R5),	@SP		;GET THE CALL ITSELF ONTO THE STACK.
	MOV	-2(SP),	STATUS		;RESTORE STATUS, T-BIT, ETC.
	ASRB		@SP		;EXAMINE LOW ORDER BIT OF CALL
	BPL	PRINTA			;GO PRINT ASCII CODES.
	BCS	ERR2			;USE ODDS AS ERRORS
	ROLB	@SP			;RESTORE WORD ADDRESS
	SUB	#JMS,	@SP		;COMPUTE ADDRESS OF THE POINTER.
	MOV	@(SP)+,	PC		;GOTO THE PROCESS.

;ERROR DIAGNOSTIC GENERATOR

ERR2:	MOV	#TKS,	INDEV		;RESET DEVICE POINTERS
	MOV	#TPS,	OUTDEV		;...
	PRINT2, 37616			;PRINTS AS "CR-LF"+"?"
	BIC	#-40,	@SP		;CLEAR THE HIGH ORDER BITS
	MOVB	(SP)+,	PTR		;SAVE CODE NUMBER
	PUSHJ	PRNT2			;AND PRINT IT.
	PRINT2,	" A			; "AT "
	PRINT+	'T			;...
	MOV	PCF,	AC		;WHAT TYPE LINE ARE WE POINTING TO?
	MOV	2(AC),	AC		;RETRIEVE THAT LINE NUMBER.
	PRNTLN				;PRINT IT OUT.
	PRINT2,	CRLF			;GO BACK TO COMMAND/INPUT MODE.

;"START"


STARTX:	MOV	STACKO+2,SP		;INITIALIZE THE STACK POINTER
	MOV	#PC1+2,	PCF		;INITIALIZE PC FOR FOCAL
	MOV	#-400,	DEBG		;ENABLE TRACE BUT TURN  IT OFF
	CLR	WHOOPS			;UPDATE POWER FAIL SWITCH
	CLR	STATUS			;ALLOW INTERRUPTS
	BIS	#100,	@#TKS		;ENABLE TELETYPE INTERRUPTS.
	CMP	INDEV,	#PRS		;DON'T ACKNOWLEDGE FOR H.S.R.
	BEQ	.+4			;...
	PRINT+	'*			;PRINT THE "READY" CODE.
	MOV	BUFR,	R5		;INIT THE COMMAND BUFFER PROTECTION.
	TST	(R5)+			;LEAVE HOLE
	MOV	R5,	AXIN		;FOR PACKING AND RUBOUT LIMIT.
IGNOR:	READC				;WAIT FOR KEYBOARD INPUT.
	CMPB	CHAR,	#012		;CHECK FOR TERMINATORS
	BEQ	IGNOR			;IGNORE LINEFEED
	PACKC				;PACK THE COMMAND STRING
	CMPB	CHAR,	#216		;TEST FOR C.R.
	BNE	IGNOR			;NO, REPEAT.
	MOV	R5,	AXOUT		;SETUP FOR READING THE COMMAND/INPUT STRING
GONE:	GETC				;GET A CHARACTER
	SPNOR				;IGNORE SPACES BEFORE LINE NUMBERS.
	SKPNON				;BE SURE THAT IT IS A NUMBER
		INPUTN			;NOT A TERMINATOR, BEFORE STORING.
	PUSHJ		PROC		;PROCESS IMMEDIATE COMMAND
	MOV	PCF,	AXOUT		;COMPUTE ADDRESS OF NEXT
	ADD	(AXOUT)+,AXOUT		;LINE IN SEQUENCE.
	BEQ		STARTX		;END FORMAT=RETURN TO C/I MODE.
	MOV	AXOUT,	PCF		;SAVE NEXT LINE ADDR.
	CMP	(AXOUT)+,(AXOUT)+	;PREPARE TO INTERPRET.
	BR    GONE			;GO EXECUTE IT.


INPUTN:	MOV	@PC,	DEBG		;DISABLE AND TURN OFF THE TRACE.
	GETLN				;READ THE DATA AS A LINE  NUMBER
	BMI	      .+4		;SKIP OVER ERROR CALL IF SINGLE LINE NUMBER.
LINERR:	ERROR	1.			;ILLEGAL LINE NUMBER.
	SPNOR				;IGNORE SPACES AFTER LINENUMBER.
					;PREPARE POINTER TO INSERT NEW TEXT AND
	MOV	AC,	(R5)+		;SAVE THE LINE NUMBER.
	MOV	R5,	AXIN		;SETUP INPUT INDEX.
	BR		SRETN		;SKIP TO THE TEST FOR END-OF- LINE.
	MOVB	(AXOUT)+,CHAR		;UNPACK A CHARACTER W/O TRACE.
SRETN:	PACKC				;SAVE THE BYTE
	CMPB	#CR,	CHAR		;TEST FOR END OF LINE.
	BNE		SRETN-2		;GO BACK FOR ANOTHER.
	DELETE				;REMOVE THE OLD LINE, IF ANY. (NO BREAKS!)

;AT THIS JUNCTURE
;(PTR)=>LASTLN
;(AXIN)=(BUFR)+NEW.LENGTH
;(BUFR)=>THISLN

	MOV	PTR,	AC		;COMPUTE THE NEXT FROM "LASTLN=PTR".
	ADD	@AC,	AC		;LINE ADDRESS AS "C-2" THEN
	SUB	BUFR,	AC		;FORM "C-NEW-2".
	MOV	AC,	@BUFR		;SAVE NEW FORWARD LINKAGE.
	ADD	#2,	AC		;"C-NEW"
	SUB	AC,	@PTR		;UPDATE OLD LINKAGE "NEW-A"
	MOV	AXIN,	BUFR		;POINT TO END OF LAST INSERTION.
	BR	STARTX			;RETURN TO COMMAND/INPUT MODE.

;"TESTC"

;CALLING SEQUENCE:
;TESTC	;CALL WITH (CHAR)=TEST DATA
;TADDR	;"TERMINATOR
;NADDR	;"NUMBER
;FADDR	;"FUNCTION
;	;RETURNS IF "ALPHA

TESTX:	SPNOR				;TEST FOR SPACE AND IGNORE.
	BMI		TEX		;MUST BE TERMINATOR
	TST		(R5)+		;PREPARE SECOND RETURN
	SKPNON,	TEX			;IF NUMBER,TAKE EXIT
	CMPB	#056,	CHAR		;OR A POINT?
	BEQ	TEX			;YES, USE "NADDR."
	TST		(R5)+		;PREPARE FOR 3RD RETURN
	CMPB	#'F,	CHAR		;TEST FOR FUNCTION DESIGNATION
	BNE		SOX		;RETURN,	 MUST BE "ALPHA
TEX:	MOV	@R5,	R5		;GO BACK VIA POINTER
	RTS		R5		;IN ARGUMENT LIST.


;"SKPNON,	YES-ADDR"

;SKIP IF NOT A NUMBER

SKPNOX:	CMPB	CHAR,	#060		;TEST 0
	BLT	SOX			;TOO SMALL
	CMPB	CHAR,	#072		;TEST 9
	BR	GROVZ			;NUMBER,USE YES-ADDRESS



;"PRINT+	'X"

PRINTA:	ROLB	@SP			;USE LOW BITS AS ASCII CODES.
	MOVB	CHAR,	1(SP)		;LEAVE OLD "CHAR" IN THE STACK FOR "OUTX-2"
	MOVB	@SP,	CHAR		;...
	SWAB	@SP			;...
	BR	OUTZ			;PRINT IT.
;"SORTJ"

;CHARACTER TEST AND BRANCH ROUTINES
;SORTJ,	 LISTCHAR, LISTADDR, RETURN-IF-NOT-THERE

SORTB:	MOV	(R5)+,	AC		;PICKUP THE LIST POINTER AND
	CMPB	CHAR,	@AC		;TEST WITH LIST CONTENTS.
	BEQ		SOUND		;MATCH FOUND!
	TSTB		(AC)+		;TEST FOR END OF LIST OR
	BNE		SORTB+2		;REPEAT IF NOT AT END
SOX:	TST		(R5)+		;RETURN IF NO MATCH FOUND
	RTS	    R5			;GO BACK VIA R5.
					;
SOUND:	SUB	-2(R5),	AC		;COMPUTE THE INDEX FIRST THEN
	ASL	AC			;MAKE EVEN AND
	ADD	@R5,	AC		;GET TABLE OF ADDRESSES AND FINALLY
	MOV	@AC,	R5		;SETUP ADDRESS FOR PC.
	RTS		R5		;GO BACK VIA NEW R5.



;"SORTC"

;SORTC,LISTCHAR,YESADDR,RETURN-IF-NOT-THERE

SORTD:	MOV	(R5)+,	AC		;GET LIST ADDRESS
	CMPB	@AC,	CHAR		;COMPARE WITH CONTENTS
	BEQ		TEX		;FOUND IT.
	TSTB		(AC)+		;TEST NEXT FOR END
	BNE		SORTD+2		;REPEAT
	BR		SOX		;EXIT IF NOT THERE



;"GETLN"

;LINE NUMBER FORMATION ROUTINE

GETLNX:	CLRB		SWITCH		;SET TO TERMINATE UPON ALPHA CODES
	CLR		LINENO		;AND USE INTERNAL DATA
	CLR		AC		;FOR "ALL.
	SPNOR				;IGNORE LEADING SPACES
	BMI	GALL			;TERMINATOR=0="ALL"
	CMPB	#'A,	CHAR		;TEST FOR "ALL
	BEQ	GALL			;GO SET SWITCH AND RETURN OK
	SKPNON,	GTESTN			;SOUNDS LIKE A VARIABLE NAME?
	MOV	R5,	-(SP)		;SAVE RETURN
	PUSHJ	GETARG			;READ A NAMED LINE
	FGET+IPTR			;PICKUP THE VALUE.
	MOV	(SP)+,	R5		;RESTORE RETURN
GTESTW:	ADD	#8.,	BE		;MOVE 'POINT'RIGHT 8 BITS
	FINT				;FIX
	MOV	AC,	LINENO		;SAVE THE ANSWER IN "AC" AND "LINENO"
	BEQ		GALL		;ZERO, CALL IT THE SAME AS "ALL"
	BMI	LINERR			;PREVENT USE OF BIT 15
	TSTB		AC		;TEST THE STEP-NO.
	BEQ		GGROUP		;MUST BE A GROUP.
	TSTB		LINENO+1	;TEST THE GROUP-NO
	BEQ	LINERR			;MUST BE NON-ZERO
	BISB	#ONE,	SWITCH		;INDICATE A SINGLE LINE
	RTS		R5		;RETURN
					;
GALL:	INCB		SWITCH		;SET BIT #0 FOR "ALL".
GGROUP:	RTS		R5		;RETURN TO PROCESS WITH STATUS BITS SETUP.
					;LINE NOS. >99.99 ARE NOT ERROR CHECKED.

GTESTN:	FREAD				;SET TO READ A NUMBER INTERNALLY.
	BR	GTESTW			;GO PROCESS THE RESULT

;"FINDLN"

;THIS ROUTINE LOOKS UP THE LINE WHOSE NUMBER
;MATCHES THE CONTENTS OF "LINENO"
;CALLING SEQUENCE: FINDLN,	NOTADDR,RETURN-IF-FOUND

;RESULTS IF FOUND:"THISLN"=FOUND LINE OR NEXT LARGER:
;"PTR" IS THE LAST LINE, I.E.PRECEEDING OR SAME LINE.
;"AXOUT"IS SET FOR USE BY "GETC".

;RESULTS IF-NOT-FOUND: "THISLN"=ADDRESS OF NEXT IN LINE
;			 "AXOUT"=NEXT OR ZERO
;			 "PTR"=PRIOR LINE


FINDX:	MOV	#CFRS,	AXOUT		;LOAD STARTING ADDRESS OF TEXT
	MOV	AXOUT,	PTR		;INIT FOLLOWING POINTER
FINDN:	MOV	AXOUT,	THISLN		;SAVE CURRENT POINTER
	CMP	2(AXOUT),LINENO		;TEST FOR MATCH
	BGT		TEX		;PAST IT!=NOT FOUND
	BEQ	FINDO			;RIGHT ON!
	MOV	AXOUT,	PTR		;COPY PRIOR POINTER.
	ADD	(AXOUT)+,AXOUT		;GET NEW POINTER
	BEQ		TEX		;END OF LIST=NOT FOUND
	BR		FINDN		;TRY THE NEXT ONE.
FINDO:	CMP	(AXOUT)+,(AXOUT)+	;MAKE IT POINT TO TEXT
	BR		SOX		;RETURN TO SEQUENCE

;DATA STRUCTURE OF LINES:

;WORD #1 :	NEXT-.-2		;LAST IS 0-.-2
;WORD #2 :	LINE#			;GROUP. STEP
;WORDS #3-N:	7-BIT ASCII AND SPECIAL INTERNAL TEXT CODES
;LAST BYTE :	 216		;CARRIAGE RETURN





;"PRINT2,	"ARGARG"

PRIN2A:	MOVB	(R5)+,	CHAR		;COPY FIRST TRAILING BYTE
	PRINTC				;AND PRINT
	MOVB	(R5)+,	CHAR		;COPY SECOND TRAILING BYTE
	BR	OUT			;AND GO PRINT IT



;"SKPLPR,	  NOT-ADDR"

;BRANCH IF LEFT-PARENS. NOT FOUND.

XTSTLP:	CMPB	CHAR,	#210		;TEST FOR (<[.
	BHI	TEX			;RIGHT TERMINATOR? - YES, USE "NOT-ADDR".
	CMPB	CHAR,	#206		;OUT OF RANGE?
GROVZ:	BLO	TEX			;YES, USE "NOT-ADDR"
	BR	SOX			;OK, SKIP ONWARDS.



;"DIGTST,	FIELD"

DIGTSA:	MOV	#60,	CHAR		;INITIALIZE CHARACTER
	CMP	PTR,	@R5		;TEST FOR POSSIBILITY
	BLT		SOX		;LEAVE IF NO MORE POSSIBLE
	SUB	@R5,	PTR		;MAKE CHANGE AND
	INC		CHAR		;COUNT
	BR		DIGTSA+4	;REPEAT



;"GROOVY,	NOT-ADDR"

GROVX:	CMPB	LINENO+1,3(AXOUT)	;TEST FOR SAME GROUP
	BNE	TEX			;GO BRANCH OR
	TST	AXOUT			;CHECK FOR END OF TEXT
	BEQ	TEX			;TAKE NOT-ADDR
	BR	SOX			;JUST RETURN



;"READC" AND "PRINTC"

;I/O CONTROLS

CHIN:	INCH				;READC = INPUT
	BIC	#-200,	CHAR		;CLEAR HIGH ORDER BITS
	BEQ		CHIN		;IGNORE NULLS
	SORTC,	ECHOLST,RUBX2		;TEST FOR NO-ECHO
	SORTC,	TERMS,CHINX		;CONVERSION TEST.
	BR		OUTW		;GO ECHO
					;
CHINX:	ADD	#200-TERMS,AC		;FORM INTERNAL CODE
	MOVB	AC,	CHAR		;AND SAVE IT
OUTW:	CMP	#SCONL,R5		;DON'T
	BEQ	RUBX2			;ECHO SEARCH CHARACTER FROM *MODIFY*.
	CMP	INDEV,	#PRS		;DON'T
	BEQ	RUBX2			;ECHO FOR H.S.R.
OUT:	MOVB	CHAR,	-(SP)		;SAVE THIS FORM ON THE STACK.
	BPL	OUTZ			;IF SPECIAL TERM., REGENERATE BY
	MOVB	TERMS+200(CHAR),CHAR	;COMPUTING ASCII
OUTZ:	BISB	#200,	CHAR		;SET BIT8.
	OUTCH				;OUTPUT TO ANY DEVICE.
	CMPB	#215,	CHAR		;(CHANGED BY 'OUTCH')
	BNE	OUTY			;JUST GO COUNT IT.
	MOVB	#73.,	LINCNT		;INITIALIZE THE LINE COUNT.
	CMPB	@SP,	CHAR		;WAS THIS AN INTERNAL CR?
	BLO	OUTY			;IF NOT, JUST GO COUNT.
	PRINT+012			;ISSUE THAT EXTRA LINEFEED.
OUTY:	CMP	OUTDEV,	#TPS		;TEST FOR TTY OUTPUT.
	BNE	OUTX			;IF NOT, DON'T EDITORIALIZE.
	DECB	LINCNT			;COUNT PRINT POSITIONS
	BNE	OUTX			;SKIP IF NOT NEAR THE MARGINS
	PRINT2,	CRLF			;OUTPUT ONE OF EACH
OUTX:	MOVB	(SP)+,	CHAR		;RESTORE ORIGINAL DATA
	RTS	R5			;RETURN FROM TRAP




;"PRNTLN"

;PRINT A LINE NUMBER ROUTINE

XPRNTL:	MOV	#2005,	PTR		;SET FORMAT TO %4.02
	MOV	AC,	-(SP)		;ARGUMENT TAKEN FROM "AC"
	MOV	#177407,-(SP)		;...
	FGET+FROM+STACK			;LOAD FLAC
	FPRINT				;PRINT RESULT
	CLOSE+STACK			;REPAIR HOLE IN THE STACK.
	PRINT+	' ;			;PRINT TRAILING SPACE
	RTS	R5			;RETURN




;"SPNOR"

;IGNORE SPACES

	GETC				;MOVE ON TO NEXT CHARACTER CODE.
SPNORX:	CMPB	#200,CHAR		;CHECK FOR SPACE SYMBOL.
	BEQ	.-6			;TRY AGAIN.
	BR	RUBX2			;LEAVE "CHAR" IN "STATUS" AND EXIT.

;"PACKC"

;TEXT BUFFER CONTROLS

PACKX:	MOV	AXIN,	TEMP		;COPY INPUT TEXT POINTER.
	CMPB	#177,	CHAR		;TEST FOR RUBOUT
	BEQ		RUBIT		;GO BACK UP ONE SPACE
	CMPB	#100,	CHAR		;TEST FOR  AT SIGN
	BEQ	RUBX			;IGNORE IT
	CMPB	#137,	CHAR		;LEFT ARROW
	BEQ	PBAR			;GO RESET.
	MOVB	CHAR,	(TEMP)+		;SAVE CHARACTER CODE AND MOVE POINTER.
	CMPB	#CR,	CHAR		;TEST FOR C.R.
	BNE		PACKY		;BRANCH OTHERWISE
	INC		TEMP		;ROUND UP TO EVEN VALUE
	BIC	#1,	TEMP		;000
PACKY:	CMP	TEMP,	STARTV		;TEST FOR INTERFERENCE WITH VARIABLE AREA.
	BLT	PACKZ			;NO INTERFERENCE YET.
	ERASEV				;USES ONLY AC
PACKZ:	CMP	TEMP,	BOTTOM		;TEST FOR FULL DATA AREA
	BLT		RUBX		;NOT YET FULL
	ERROR	10.			;OUT OF CORE SPACE-OR TRYED TO DELETE LINE ZERO
PBAR:	MOV	@SP,	TEMP		;RESET INPUT POINTER.
RUBIT:	CMP	TEMP,	@SP		;TEST FOR NULL LINE(OLD R5 IS "PACKST")
	BEQ		RUBX		;IGNORE R.O. CODE COMPLETELY
	DEC		TEMP		;BACKUP ONE PLACE
	PRINT+	'\			;AND ACKNOWLEDGE RECEIPT + USE.
RUBX:	MOV	TEMP,	AXIN		;SAVE POINTER
RUBX2:	MOVB	CHAR,	CHAR		;SET CONDITION CODES BEFORE LEAVING.
	RTS	R5			;RETURN TO MAINLINE ROUTINES.






;"GETC"

;UNPACK A CHARACTER AND LEAVE IN 'STATUS'

UTX:	TSTB		DEBG		;TEST FOR TRACE ENABLED
	BNE		RUBX2		;RETURN IF NOT ENABLED.
	COMB		DEBG+1		;FLIP THE TRACE FLOP
GETX:	MOVB	(AXOUT)+,CHAR		;PICK OUT NEXT BYTE
	CMPB	#'?,	CHAR		;CHECK FOR TRACE FLIP-FLOP CODE
	BEQ		UTX		;GO FLIP IT IF CODE FOUND PLUS ENABLED.
	TST		DEBG		;TEST FOR BOTH DEBG+DMPS=0.
	BNE		RUBX2		;NOT IN TRACE NOW.
	BR		OUT		;GO PLAY-BACK THE BYTE.


;"DELETE"

; A LINE AND
;GARBAGE COLLECTION IS DONE UP TO (AXIN);
;(BUFR) IS CORRECTED;
;(TEMP) IS AMOUNT OF CODE COLLECTED.

ECOLOGY:MOV	(AXOUT)+,(CHAR)+	;STEP 3-COLLECT SPACE
	CMP	AXOUT,	AXIN		;TEST FOR COMPLETION
	BLT		ECOLOGY		;CONTINUE UNTIL FINISHED.
	SUB	TEMP,	BUFR		;UPDATE END OF TEXT POINTER.
	SUB	TEMP,	AXIN		;...
					;*** NO INTERRRUPTS!
XDELET:	FINDLN,	PWRON			;SETUP LINE POINTERS FOR EXIT
XD3:	MOVB	(AXOUT)+,CHAR		;READ THROUGH THE LINE
	CMPB	#CR,	CHAR		;CARRIAGE RETURN MARKS END
	BNE		XD3		;REPEAT UNTIL END REACHED.
	INC		AXOUT		;ROUND OUT THE POINTER
	BIC	#1,	AXOUT		;TO AN EVEN NUMBER.
	MOV	THISLN,	CHAR		;COPY POINTER TO THIS LINE.
	ADD	@CHAR,	@PTR		;STEP 1-CREATE NEW RELATIVE
	ADD	#2,	@PTR		;POINTER TO NEXT LINE IN LIST.
	MOV	AXOUT,	TEMP		;COMPUTE DELTA POSITION
	SUB	CHAR,	TEMP		;AS A POSITIVE, EVEN NO. OF BYTES.
	MOV	#CFRS,	AC		;BEGIN AT TOP TO GARBAGE COLLECT.
XDOX:	MOV	AC,	PTR		;STEP 2-FOLLOW + UPDATE LINKS ("THIS")
	BEQ	ECOLOGY			;GO COLLECT ALL
	ADD	(AC)+,	AC		;TEST FOR LAST OF KIND.
	CMP	PTR,	AXOUT		;TEST FOR ABOVE OR BELOW CHANGE AND
	BLT		XDTHIS		;BRANCH TO FIXUP THIS ONE IF IT  IS  ABOVE
	CMP	AC,	AXOUT		;TEST FOR NEXT-IS-BELOW AND
	BGE		XDOX		;BRANCH TO NEXT ONE IS ALSO BELOW
	ADD	TEMP,	@PTR		;ADD THE CHANGE AND
	BR		XDOX		;GO LOOK AT NEXT ITEM.
					;
XDTHIS:	CMP	AC,	AXOUT		;IS NEXT ONE ABOVE THE CHANGE ALSO?
	BLT		XDOX		;YES, CONTINUE.
	SUB	TEMP,	@PTR		; NO,CHANGE "LINE".
	BR		XDOX		;GO TO NEXT LINE

;	HERE-THERE=CHANGE HERE
;	A	A	0
;	B	B	0
;	A	B	-T
;	B	A	+T



;*IF*

;CONDITIONAL TRANSFER PROCESS

IF:	MOV	CHAR,	-(SP)		;SAVE LPAR FOR "PARTST".
	EVAL.X				;EVALUATE THE EXPRESSION WITH PARENTHESES
	PARTST				;CHECK CLOSING PARENS.
	MOV	#-2,	R5		;SETUP A SINGLE COUNTER
	MOV	HORD,	AC		;TEST THE SIGN OF THE EXP.
	BGE		.+6		;GO SETUP -1 OR -2 FOR 0 OR +
	INC		R5		;SETUP 0 OR -1 FOR - OR 0
	TST		AC		;MAKE FINAL CHECK
	BLE		IF3		;SKIP IF 0 OR +
IF4:	GETLN				;IGNORE ONE LINE NO. FIELD; END OR RETURN.
	SORTJ,TLIST,ILIST		;TEST FOR , ; C.R.
	ERROR	18.			;BAD FORMAT IN *IF* COMMAND
IF1:	GETC				;BYPASS COMMA AND
IF3:	INC		R5		;BACKUP COUNTER ONE PLACE
	BNE		IF4		;USE THE LINE NUMBER AFTER ENOUGH COMMAS PASSED.

;FALL THROUGH INTO *GOTO*


;*GO*GOTO*COMMENT*CONTINUE*RETURN*XECUTE*

;PRIMARY CONTROL AND TRANSFER

GOTO:	GETLN				;READ THE ADDRESS AND
	FINDLN,	SERR			;ATTACH TO NEW LINE.
PSCAN:	MOV	THISLN,	PCF		;SET NEW LINE POINTER
PROCESS:GETC				;READ A CHARACTER IN LINE
PROC:	CMPB	CHAR,	#CR		;TEST FOR END OF LINE
	BEQ		PC1		;GO-ON TO PROCESS NEXT LINE
	MOVB	CHAR,	AC		;COPY DATA
	BMI	PROCESS			;IGNORE TERMINATORS
	CMPB	#'A,	CHAR		;CHECK DATA
	BGT	ERRORC			;TOO LOW.
	CMPB	#'X,	CHAR		;TOO HIGH?
	BGE	PC2			;OK
ERRORC:	ERROR	4.			;ILLEGAL COMMAND CODE.
PC2:	GETC				;IGNORE REST OF THE COMMAND'S
	BPL	PC2			;CHARACTERS UNTILL TERMINATOR REACHED.
	SPNOR				;SKIP EXTRA SPACES NOW.
	ASL	AC			;MAKE BYTE COUNT INTO WORD COUNT.
	JMP @COMLST-202(AC)		;BRANCH TO THE COMMAND PROCESS.
					;
RETURN:	MOV	#PC1+2,	PCF		;RETURN FROM SUBROUTINE (?)
PC1:	POPJ				;EXIT FROM LINE
	-.-2				;DUMMY TERMINATOR
FLTZER:	00000				;DUMMY LINE NUMBER ZERO
	00000				;AND DUMMY VALUE OF FLOATING ZERO.
;
TPR:	TST	(SP)+			;DUMP RETURN FOR 'TASK' UPON SEMICOLONS.
	BR		PROCESS		;GO END REST OF COMMAND LINE.
;
TPR1:	TST		(SP)+		;DUMP RETURN UPON C.R.
	POPJ				;GO EXIT FROM A LINE.
;
XECUTE:	EVAL.X
	BR	PROCESS

;*MODIFY*

;SEARCH FOR CHARACTER IN TEXT

MODIFY:	GETLN				;READ COMMAND ARGUMENT
	FINDLN,	SERR			;LOOKUP THE INPUT DATA
	MOV	BUFR,	R5		;COMPUTE START OF NEW LINE
	CLR	(R5)+			;ZERO LIST LINK AND
	MOV	AC,	(R5)+		;SAVE OLD LINE NUMBER
	BEQ	SERR			;FLAG "M 0" ERROR IMMEDIATELY.
	MOV	R5,	AXIN		;SETUP INPUT POINTER
SCONT:	READC				;READ SEARCH CHARACTER SILENTLY.
SCONL:	MOVB	CHAR,	LIST3+1		;SAVE SEARCH CHARACTER
SCHAR:	MOVB	(AXOUT)+,CHAR		;UNPACK AND PRINTOUT
	PRINTC				;EXTRA OUTPUT FOR C.R.
	SORTJ,	LIST3,LISTGO		;TEST FOR C.R. OR SEARCH CHARACTER
	PACKC				;SAVE OLD CHARACTER.
	BR		SCHAR		;REPEAT
					;
SFIND:	READC				;ABSORB AND ANALYSE
	SORTJ,	LIST6,SRNLST		;THE INPUT TEXT
SFOUND:	PACKC				;PACK NEW CHARACTER
	BR		SFIND		;REPEAT
					;
SERR:	ERROR	5.			;NONEXISTANT LINE OR LINE ZERO


;*WRITE*

;OUTPUT COMMAND TEXT

WRITE:	GETLN				;READ THE ARGUMENT
	FINDLN,	WTESTG			;LOOKUP THE LINE
	MOV	-2(AXOUT),AC		;TEST FOR LINE ZERO
	BEQ		WRITEL		;BRANCH TO PRINT TITLE ONLY
	PRNTLN				;PRINT NON-ZERO LINE NOS. IN "AC"
WRITEL:	MOVB	(AXOUT)+,CHAR		;READ W/O TRACE
	PRINTC				;PRINT ONE CHARACTER
	CMPB	#CR,	CHAR		;TEST FOR END
	BNE		WRITEL		;REPEAT
	MOV	THISLN,	AXOUT		;COMPUTE NEXT LINE
	ADD	(AXOUT)+,AXOUT		;ADDRESS READY NOW.
	BEQ		WGO		;LEAVE IF LAST LINE.
WTESTG:	TSTB		SWITCH		;TEST FOR SINGLE LINE
	BMI		WGO		;YES=EXIT
	GROOVY,	WRED			;SAME GROUP AS LAST LINE?
WRIG:	COPYLN				;COPY THIS NEXT LINE NUMBER.
	BR	WRITE+2			;GO FIND IT.
WRED:	PRINTC				;PRINT EXTRA CR AFTER GROUP.
	BITB	#ALL,	SWITCH		;TEST FOR "ALL"?
	BNE		WRIG		;YES,KEEP IT UP.
WGO:	POPJ				;RETURN



;*ERASE*ERASE ALL*ERASE 'GROUP.LINE'*

ERASE:	TESTC				;TEST THE ARGUMENT, IF ANY.
		ERVC			;ERASE "VARIABLES
		ERL			;ERASE LINE
		LINERR			;ERROR,
	CMP	#'A,	CHAR		;TEST FOR "ALL
	BNE		ERL		;WHY NOT USE A VARIABLE NAME ?
	MOV	TOP,    BUFR		;ERASE ALL TEXT
	MOV	#0-CFRS-2,CFRS		;INITIALIZE LINE ZERO POINTER DATA
ERV:	ERASEV				;ERASE THE VARIABLES ALSO
	START				;GO TO COMMAND/INPUT MODE
					;
ERL:	GETLN				;READ THE LINE NO. OR GROUP NO.
	TST	AC			;DON'T ERASE
	BEQ	SERR			;LINE ZERO
ERG:	DELETE				;EXTRACT ONE LINE (NO BREAKS!)
	TSTB	SWITCH			;TEST FOR SINGLE OR GROUP
	BMI		ERV		;ONLY ONE
	TST	AXOUT			;CHECK FOR END OF LIST TO
	BEQ	ERV			;AVOID REALLY WILD LOOP!
	GROOVY,	ERV			;TEST FOR SAME GROUP MEMBER
	COPYLN				;MOVE AHEAD
	BR		ERG		;AND DO ANOTHER.
					;
ERVC:	ERASEV				;*E* COMMAND IN TEXT IS OK.
	POPJ				;GO TO NEXT LINE OF PROGRAM.



;"COPYLN"

;USED BY *WRITE*, *ERASE*, AND *DO*

COPYLX:	MOV	2(AXOUT),LINENO		;USE NEXT LINE NUMBER
	RTS	R5			;RETURN TO *WRITE*ERASE*DO*.


;*DO*

;RECURSIVE OPERATE

DO:	GETLN				;READ LINE # ARGUMENT
	MOV	CHAR,	-(SP)		;SAVE THE NEXT CHARACTER.
	MOV	PCF,	-(SP)		;SAVE ADDRESS OF LINE AND
	MOV	AXOUT,	-(SP)		;CHARACTER POINTER OF CURRENT LOCATION
	FINDLN,	DOGR			;LOOKUP THE LINE
	BR		DOGRP1		;FOUND!
					;
DOGR:	TSTB		SWITCH		;TEST FOR SINGLETON
	BMI	DOER			;YES, OUGHT TO HAVE BEEN THERE.
					;C(THISLN)=C(AXOUT).
	GROOVY				;COMPARE GROUP NOS.
			DOER		;ERROR, NO SUCH GROUP
DOGRP2:	COPYLN				;COPY FIRST LINE NO. OF THE GROUP
	CMP	(AXOUT)+,(AXOUT)+	;POINT FORWARD
DOGRP1:	MOVB	SWITCH,	-(SP)		;SAVE FLAGS
	MOV	THISLN,	-(SP)		;SAVE ADDRESS OF LINE BEING DONE
	PUSHJ		PSCAN		;SCAN COMMANDS IN THAT LINE
	MOV	(SP)+,	TEMP		;RESTORE LINE LAST DONE ADDRESS
	MOVB	(SP)+,	SWITCH		;RESTORE CORRECT SCOPE OF "DO"
	BMI	DCONT			;IF SINGLE LINE, WE ARE DONE NOW.
	MOV	PCF,	AXOUT		;KEEP POINTER TO NEXT LINE TO BE DONE.
	ADD	(AXOUT)+,AXOUT		;COMPUTE NEXT ADDRESS IN GROUP.
	BEQ		DCONT		;LEAVE IF OUT OF TEXT ALTOGETHER
	MOV	AXOUT,	THISLN		;SAVE POINTER
	BITB	#ALL,	SWITCH		;TEST FOR "DO" OR "DO ALL"
	BNE		DOGRP2		;...
	CMPB	3(TEMP),3(AXOUT)	;COMPARE GROUP NOS.
	BEQ		DOGRP2		;GO DO NEXT ONE.
DCONT:	MOV	(SP)+,	AXOUT		;...
	MOV	(SP)+,	PCF		;...
	MOV	(SP)+,	CHAR		;RESTORE THE LAST CHARACTER.
	JMP		PROC		;CONTINUE THE STRING
					;
DOER:	ERROR	6.			;NO SUCH GROUP TO BE DONE.

;*SET*FOR*

;LOOP CONTROL STATEMENT

SET=.
FOR:	PUSHJ		GETARG		;LOCATE THE VARIABLE
	SPNOR				;IGNORE TRAILING SPACES (O'D)
	CMPB	#217,	CHAR		;TEST FOR "="
	BNE	FINERR			;ERROR TO LEFT OF = SIGN
	MOV	PTR,	-(SP)		;SAVE VARIABLE POINTER ON THE STACK.
	EVAL.X				;EVALUATE RIGHT HAND EXP.
	FPUT+THROUGH+STACK		;UPDATE+INDEX VALUE
	SORTJ,TLIST,FLIST1		;TEST TERMINATOR
FINERR:	ERROR	7.			;ILLEGAL FORMAT IN *SET* OR *FOR* COMMAND
FINCR:	EVAL.X				;EVALUATE EXPRESSION.
	SORTJ,TLIST,FLIST2		;TEST TERMINATOR
	BR		FINERR		;ERROR CALL
FINFIN:	MOV	#40000,	-(SP)		;SET THE
	MOV	#1,	-(SP)		;INCREMENT TO UNITY
	BR		FCONT		;GO SAVE THE LIMIT.
					;
FLIMIT:	OPEN+STACK			;SAVE INCREMENT
	FPUT+INTO+STACK			;...
	EVAL.X				;EVALUATE LIMIT
FCONT:	OPEN+STACK			;SAVE THE LIMIT.
	FPUT+INTO+STACK			;...
FCONT2:	MOV	AXOUT,	-(SP)		;SAVE TEXT POINTER ID AND
	MOV	PCF,	-(SP)		;CURRENT LINE ADDR THEN
	PUSHJ	PROCESS			;GO EXECUTE THE REST OF THE LINE
	MOV	(SP)+,	PCF		;RESTORE TEXT POINTERS
	MOV	(SP)+,	AXOUT		;...
	MOV	10(SP),	PTR		;GET VAR POINTER
	MOV	SP,	-(SP)		;CREATE INDEXED ADDRESS OF INCREMENT
	ADD	#6,	@SP		;...
	FGET+IPTR			;LOAD FLAC WITH THE VARIABLE
	FADD+THROUGH+STACK		;ADD THE INCREMENT AND
	FPUT+IPTR			;SAVE IT
	TST	(SP)+			;INDEX TO  THE LIMIT
	FSUB+FROM+STACK			;COMPARE RESULT WITH LIMIT
	TST	HORD			;AND DROP INDEXED POINTER.
	BLE	FCONT2			;REPEAT. IF LIMIT NOT EXCEEDED 
	ADD	#12,	SP		;UNLOAD THE STACK.
	POPJ				;EXIT THE COMMAND.

;'EVAL'

;EVALUATE AN EXPRESSION

ELPAR:	SKPLPR,	OPERR			;ILLEGAL TO STATE EXPRESSION WITH RIGHT PARENS.
EPAR2:	MOV	CHAR,	-(SP)		;SAVE THE LP CODE AND COMPUTE THE
	MOV	#EFUN3, -(SP)		;LOAD TRANSFER FOR "POPJ" AT "EXIT"
	GETC				;MOVE ONTO NEXT CHARACTER
EVAL:	CLR	-(SP)			;SET LASTOP=0
	TESTC				;TEST CHARACTER TYPE:
		ETERM1			;COULD BE A UNARY OPERATOR
		ENUM			;OR A NUMBER,
		EFUN			;OR A FUNCTION,
OPNEX1:	PUSHJ		GETVAR		;OR A VARIABLE
OPNEXT:	SPNOR				;IGNORE SPACES AROUND OPERATORS (O'D)
	BMI	ETERMN			;IF NEGATIVE, THEN IT IS A LEGIT. TERM.
	BR	OPERR			;OTHERWISE IT IS ILLEGAL FORMAT.
					;
ETERM1:	MOV	#FLTZER,PTR		;ASSUME PRESENT VALUE OF ZERO.
	CMPB	CHAR,	#202		;MINUS?
	BEQ		ETERM		;YES, GO PROCESS IT
	BLO		ARGNXT		;PLUS?-YES, IGNORE IT
	CMPB	CHAR,	#211		;SOME TYPE OF RIGHT TERMINATOR?
	BLO		ELPAR		;NO, GO TEST FOR LEFT PARENTHESIS SPECIAL CASE
ETERMN:	SKPLPR,		ETERM		;LEFT PAREN? - NO, CONTINUE TO PROCESS
OPERR:	ERROR	8.			;MISSING OPERATOR ERROR
ETERM:	MOVB	CHAR,	R5		;COPY THIS OP.
	CMPB	CHAR,	#211		;THISOP=RPAR?
	BLO		ETERM2		;NO
	CLR		R5		;YES, SET THISOP=ZERO
ETERM2:	CMPB	R5,	@SP		;COMPARE TWO OPERATORS
	BHI		EPAR		;LAST>THIS?-YES STACK AND CONTINUE
	MOVB	(SP)+,	TEMP		;SET LEFT HALF TO ONES OR STOP IF ZERO
	MOV	TEMP,	AC		;COPY THE OP CODE.
	BEQ	EPURE			;END OF JOB?-YES, JUST GO LEAVE RESULTS
	FGET+FROM+STACK			;NO, USE ITEM ON TOP OF STACK.
	CLOSE+STACK			;REMOVE THE ITEM
	ASLB		AC		;MOVE OPERATOR CODE INTO POSITION
	ASLB		AC		;...
	ASLB		AC		;...
	BIC	#-100,	AC		;MAKE POSITIVE.
EPURE:	ADD	#FGET+IPTR,AC		;LOAD BASE BINARY PLUS ADDRESSING MODE.
	FCODE				;EXECUTE THE AC!
	MOV	#FLARG,	PTR		;LOAD POINTER
	FPUT+IPTR			;SAVE COPY OF RESULT
	ADD	R5,	TEMP		;CHECK THISOP-LASTOP
	BNE		ETERM2		;GO COMPARE PRIORITIES.
	POPJ				;EXIT


EPAR:	SKPLPR,	EPAR1			;CHECK FOR
	BR		EPAR2		;LEFT PAREN.?-YES,
EPAR1:	MOV	2(PTR),	-(SP)		;OPEN STACK AND SAVE DATA.
	MOV	(PTR)+,	-(SP)		;...
	MOV	R5,	-(SP)		;UPDATE LASTOP
ARGNXT: GETC				;OUGHT TO BE AN ARGUMENT HERE
	TESTC				;TEST FOR THE TYPE
		ELPAR			;COULD BE EXP. IN PARENS, OR A ERROR.
		ENUM			;MANY
		EFUN			;FUNCTION
	BR		OPNEX1		;THIS ARGUMENT IS A VARIABLE.
					;
ENUM:	MOVB	#NALPHA,SWITCH		;USE INTERNAL DATA AND ACCEPT ALPHA DATA
	FREAD				;READ IN A NUMBER.
ENUM2:	MOV	#FLARG,	PTR		;SET POINTER
	FPUT+IPTR			;SAVE RESULT
	BR	OPNEXT			;GO GET OPERATOR
					;
EFUN:	CLR	R5			;OLD "EFOP"
	ASL		R5		;HASH CODE
	ROL		R5		;...
	ADD	CHAR,	R5		;...
	GETC				;READ THE MNEMONIC LETTERS
	BPL		EFUN+2		;REPEAT UNLESS TERMINATOR FOUND
	MOV	CHAR,	-(SP)		;SAVE LAST CHARACTER:PAREN.
	MOV	R5,	-(SP)		;SAVE HASH CODE
	EVAL.X				;PROCESS FIRST ARGUMENT
	MOV	(SP)+,	R5		;GET BACK "EFOP"
	MOV	#FNTABL,AC		;INIT THE SEARCH.
	TST	-(AC)			;TEST FOR END.
	BEQ	VERR			;NO SUCH FUNCTION
	CMP	-(AC),	R5		;TEST FOR MATCH
	BNE	.-6			;REPEAT IF NOT FOUND.
	JSR	PC,	@-(AC)		;CALL THE FUNCTION.
EFUN3:	PARTST				;CHECK CLOSING PARENS
	FNOR				;BE SURE THAT RESULTS ARE NORMALIZED.
	BR	ENUM2			;GO SAVE RESULTS AND SET POINTER.

EVALUX:	MOV	R5,	@SP		;SIMULATE "PUSHJ EVAL-2"
	BR	EVAL-2

;'GETVAR'

;FIND OR CREATE A VARIABLE

VERR:	ERROR	2			;ILLEGAL VARIABLE OR FUNCTION NAME.
PERR:	ERROR	3			;PAREN MISMATCH ERROR
GETARG:	TESTC				;CHECK CAREFULLY
	VERR				;T
	VERR				;N
	VERR				;F=? PTR=HOLE
GETVAR:	MOV	#100000,-(SP)		;CLEAR NAME SPACE ON STACK TO "SPACE".
	MOVB	CHAR,	@SP		;SAVE FIRST LETTER OF NAME IN STACK
	CLR		-(SP)		;CLEAR SUBSCRIPT SPACE ON STACK
	GETC				;READ AND TRACE NEXT CHARACTER
	BMI		GSERCH		;TEST FOR TERMINATOR
	MOVB	CHAR,	3(SP)		;SAVE SECOND LETTER OF NAME
	GETC				;IGNORE UNTILL TERMINATOR FOUND.
	BPL		.-2		;---
GSERCH:	SKPLPR,	GS1			;CHECK FOR SUBSCRIPT
	MOV	CHAR,	-(SP)		;SAVE LEFT PARENS. CODE.
	EVAL.X				;EVALUATE THE SUBSCRIPT AND
	FINT				;CORRECT IT TO AN INTEGER
	MOV	AC,	2(SP)		;SAVE SUBSCRIPT ON STACK
	CMPB	CHAR,	#214		;COMMA?
	BNE	GS0			;SKIP IF ONLY ONE SUBSCRIPT.
	EVAL.X				;GO READ THE SECOND SUBSCRIPT.
	FINT				;CONVERT IT TO 0-256.
	MOVB	AC,	3(SP)		;COPY 2AND INTO LEFT HALF.
GS0:	PARTST				;CHECK FOR CLOSING PARENS MATCH.

;STACK NOW CONTAINS:
;*SUBS*   (SP)
;*NAME*   2(SP)

GS1:	MOV	STARTV, TEMP		;GET TEMPORARY POINTER (UPPER LIMIT)
	MOV	BOTTOM,	AC		;GET END OF "AREA".
	MOV	AC,	R5		;COPY THE STOP VALUE (LOWER LIMIT)
	SUB	TEMP,	AC		;COMPUTE TABLE LENGTH.
	MOV	@SP,	PTR		;COPY SUBSCRIPT
	ADD	2(SP),	PTR		;COMBINE LETTERS PLUS SUBSCRIPT
	SWAB	PTR			;MAKE LAST CODES FIRST!
GS2:	SUB	AC,	PTR		;TAKE RESULT MODULO THE SIZE OF
	BHIS	GS2			;THE SYMBOL TABLE.
	COM	PTR			;COMPUTE STARTING ADDRESS "PTR"
	BIC	#7,	PTR		;MODULO 10(8)

;CHANGE #7 TO #-1 FOR A CHRONOLOGICAL TABLE.



;SEARCH VARIABLES FOR MATCH OR AN UNUSED SPACE

	ADD	TEMP,	PTR		;INITIALIZE POINTER "PTR"
	MOV	PTR,	AC		;SAVE THIS VALUE
	GTRY				;SEARCH LOWER HALF
	MOV	TEMP,	PTR		;BEGIN AT THE TOP;
	MOV	AC,	R5		;END VALUE RESTARTED.
	GTRY				;SEARCH UPPER HALF

;SEARCH FOR A ZERO-VALUE VARIABLE AND SCRATCH IT

	MOV	BOTTOM,	R5		;END AT THE BOTTOM
	GSWIPE				;SEARCH LOWER HALF OF THE MIDDLE AREA
	MOV	TEMP,	PTR		;BEGIN AT THE TOP
	MOV	AC,	R5		;END AT SAME PLACE
	GSWIPE				;SEARCH UPPER HALF
GVERR:	ERROR	11.			;JUST NO ROOM AT ALL!


;VARIABLE STORAGE:

;NAME: (B,A)
;SUBSCRIPT:	(16) OR (8,8)
;LORD,EXP	(FINAL VALUE OF PTR POINTS TO THIS LOCATION.)
;HORD:	(IF ZERO THEN ALL THESE PARTS ARE ASSUMED ZERO)

;'TEMP'	 POINTS TO UPPER LIMIT
;'AC'	 HOLDS HASH-CODE ADDRESS
;'PTR'	 SCANS THE STORAGE
;'AXOUT' POINTS TO NEXT CHARACTER
;'CHAR'	 HOLDS LAST TERMINATOR
;'R5'	 HOLDS THE SCAN LOWER LIMIT



;"ERASEV"

ERVX:	MOV	#80.,	-(SP)		;INIT VARIABLES MAY BE DONE NOW.
	ADD	BUFR,	@SP		;COMPUTE APPROXIMATE TOP END OF VARIABLE LIST.
	MOV	BOTTOM,	AC		;CLEAR UP FROM THE BOTTOM
	CMP	AC,	@SP		;DON'T VIOLATE LIMITS, PLEASE!
	BLE	GVERR			;NOT ENOUGH ROOM.
ERV2:	CLR	-(AC)			;CLEAR A WORD
	CMP	AC,	@SP		;TEST FOR END OF VARIABLE AREA
	BGE	ERV2			;REPEAT
	MOV	(SP)+,	STARTV		;SET VARIABLE STARTING ADDRESS
	RTS	R5			;AN INDIRECT COMMAND

;"GTRY"

;SCAN FOR A MATCH OR A VOID.

;CALLED BY JSR	R5,TRY
;STACK CONTAINS
;*LOWER LIMIT*	(SP)
;*SUBS*	2(SP)
;*NAME*	4(SP)
;*OLD PC*6(SP)
;PTR CONTAINS START

GTRYX:	CMP	4(SP),	@PTR		;COMPARE TRUE NAME.
	BEQ		GTEST		;GO TEST SUBSCRIPT
	TST		@PTR		;LOOK FOR NULL
GTRY2:	BEQ		GTAKE		;GO SWIPE IT!
	ADD	#10,	PTR		;MOVE POINTER
	CMP	PTR,	@SP		;TEST LIMIT
	BGE	.+4			;NO-GO, RETURN.
	TST	-(R5)			;REPEAT!
	RTS	R5			;NOT IN THAT AREA, RETURN.
					;
GTEST:	CMP	2(SP),	2(PTR)		;TEST SUBSCRIPT
	BNE		GTRY2+2		;NO GO, TRY AGAIN
	CMP	(PTR)+,	(PTR)+		;FOUND, LEAVE PTR AS POINTER
GTAK:	ADD	#6,	SP		;FLUSH STACK DATA
	POPJ				;RETURN FROM THE "GETVAR" ROUTINE.



;"GSWIPE"

;SCAN FOR A ZERO SPOT.

GSWIPX:	TST		6(PTR)		;TEST FOR ZERO-VALUE
	BR	GTRY2			;GO USE COMMON CODE.
					;
GTAKE:	MOV	4(SP),	(PTR)+		;SAVE NAME
	MOV	2(SP),	(PTR)+		;SAVE SUBSCRIPT
	BR		GTAK		;EXIT



;"PARTST"

;BE SURE PRESENT CHARACTER IS MATE TO PARENS IN THE STACK

PARTSA:	TST	(SP)+			;DUMP OLD 'R5'
	ADD	#3,	@SP		;COMPUTE MATCHING PARENS
	CMPB	CHAR,	(SP)+		;COMPARE THE ACTUAL WITH COMPUTED.
	BNE	PERR			;GO CALL "ERROR" IF THEY DON'T MATCH
	GETC				;MORE ON TO THE NEXT CHARACTER
	JMP	@R5			;RETURN TO SEQUENCE

;*TYPE*ASK*

;INPUT-OUTPUT STATEMENTS

TYPE:	TASK				;CHECK FOR SPECIAL CODES
	PUSHJ		EVAL		;EVALUATE EXPRESSION
	PRINT+	'=			;MAKE LEADIN SIGNAL.
	MOV	FISW,	PTR		;LOAD FORMAT DATA
	FPRINT				;PRINT SAME
	BR		TYPE		;REPEAT
					;
ASK:	TASK				;CHECK FOR SPECIAL CODES
	PUSHJ		GETARG		;READ NAME AND SETUP PTR
	PRINT+	':			;INDICATE READY FOR INPUT DATA.
	MOV	AXOUT,	-(SP)		;SAVE TEXT POINTER
	MOVB	CHAR,	-(SP)		;SAVE VARIABLE POINTER
	MOV	#24,	AXOUT		;MAKE COUNTER
	SUB	AXOUT,	SP		;OPEN AREA ON THE STACK
	MOV	SP,	R5		;SET RUBOUT STOP
	MOV	PTR,	-(SP)		;STACK THE DATA POINTER
	MOVB	#060,	(R5)+		;PACK A LEADING ZERO.
	MOV	R5,	AXIN		;USE FOR PACKING
	CLR	PTR			;SET SPACE - FLOP
ATAKE:	READC				;ACCEPT CHARACTER
	SORTC,TLIST,AFIX		;TEST FOR PRIME TERMINATORS
	DEC	AXOUT			;COUNT CHARACTERS
	BGT	.+4			;SKIP IF OK.
	ERROR	16.			;TOO LARGE AN INPUT STREAM.
	SORTJ,SPECIAL,INLIST		;TEST FOR ALTMODE, SPACE, R.O., L.F.
ARO:	PACKC				;PACK INPUT AND EDIT.
	BMI	ATAKE			;IF TERMINATOR, CONTINUE
	MOV	@PC,	PTR		;SET SWITCH SO THAT SPACE CODE
	BR	ATAKE			;WILL TERMINATE AND ALPHA IS ACCEPTED.
					;
ASPACE:	TST	PTR			;CHECK STATUS OF SPACE.
	BEQ	ATAKE			;IGNORE.
AFIX:	MOVB	#214,	CHAR		;PACK AN EXTRA COMMA
	PACKC				;...
	MOVB	@PC,	DEBG		;DISABLE TRACE
	MOV	R5,	AXOUT		;PICKUP DATA
	TSTB	-(AXOUT)		;BACKUP TO LEAD ZERO.
	EVAL.X				;GO READ THE NUMBER OR EXPRESSION!
	FPUT+THROUGH+STACK		;SAVE THE RESULT
	CLRB	DEBG			;RE-ENABLE TRACE
AGO:	ADD	#26,	SP		;CORRECT THE STACK
	MOVB	(SP)+,	CHAR		;RESTORE TEXT SEQUENCE
	MOV	(SP)+,	AXOUT		;...
	BR		ASK		;CONTINUE *ASK* COMMAND.



;"TASK"

;AUXILLIARY PROCESSOR FOR INPUT-OUTPUT COMMANDS

TCRLF:	PRINT2,	CRLF			;PRINT THIS CODE FOR CR+LF.
TASK4:	GETC				;MOVE TO NEXT CHARACTER
TASKX:	SORTJ,ALIST,ATLIST		;TEST FOR SPECIAL CODES
	RTS	R5			;RETURN
					;
TINTR:	GETC				;PASS PRECENT SIGN
	GETLN				;READ FORMAT CONTROL NUMBER
	MOV	AC,	FISW		;SAVE CODE
	BR		TASKX		;CONTINUE
					;
TQUOT:	MOVB	(AXOUT)+,CHAR		;BYPASS TRACE
	CMPB	#CR,	CHAR		;READ AND PRINT WITHIN QUOTES
	BEQ	TASKX			;C.R.=NORMAL RETURN FROM 'TASK'
	CMPB	#'",	CHAR		;QUOTE=CANONICAL RETURN
	BEQ	TASK4			;GO SEE WHETHER THERE IS MORE
	PRINTC				;PRINT MATERIAL.
	BR	TQUOT			;REPEAT
					;
TCRLF2:	PRINT2,	77415			;#=CR ONLY
	BR		TASK4		;BUT EXTRA RUB OUT.





;FLOATING POINT HANDLER FOR FOCAL-11

;EXTERNAL DATA IS (LORD, EXP)( HORD)
;INTERNAL DATA IS ( EXP)( HORD)(LORD)
;ARITHMETIC OPERATIONS ARE NUMBERED 0-7:
;THE ADDRESSING MODES ARE NUMBERED 0-7:

	EMT=104000
	FGET=EMT+00		;OPERATIONS
	FADD=EMT+10
	FSUB=EMT+20
	FDIV=EMT+30
	FMUL=EMT+40
;	FPOW=EMT+50
	FPUT=EMT+60		;EXPONENT ERROR ONLY.

	FNOR=EMT+70		;FUNCTIONS
	FINT=EMT+71
	FSGN=EMT+72
	FABS=EMT+73
	FNEG=EMT+74
	FREAD=EMT+75
	FPRINT=EMT+76
	FZER=EMT+77		;100 TO 177 UNUSED

	FCODE=EMT+200		;COMPUTED OPERATION IN AC


;201 TO 377 UNUSED

	STACK=0		;ADDRESSING MODES
	DIRECT=0	;ABSOLUTE (FADD DIRECT,ADDR) (NON-P.I.C.)
	IPTR=1		;@PTR
;	XPTR=2		;AUTO INDEX BY TWO WORDS.
	INTO=3		;STACK
	FROM=3		;STACK
	THROUGH=4	;STACK
	IMMED=5		;DATA FOLLOWS
;	REL=6		;RELATIVE (ADDR-.)
;	UUO=7		;UN-USED OPERATION

;"DIRECT" AND "INDEX" ARE FOLLOWED BY COMMA AND ADDRESS.


;FOCAL-11 FLOATING POINT  HANDLER

FEMT:	MOV	%5,	-(SP)		;SAVE ALL REGS.
	MOV	%4,	-(SP)		;
	MOV	%3,	-(SP)		;
	MOV	%2,	-(SP)		;
	MOV	%1,	-(SP)		;
	MOV	%0,	-(SP)		;
	MOV	14(SP),TEMP		;PICKUP ADDR OF LOC. AFTER CALL.
	MOVB	-2(TEMP),AL		;PICKUP CODED BYTE.
	BPL	FPURE			;TEST FOR CALCULATED CODES.
	MOV	AC,	AL		;YES, USE THOSE INSTEAD.
FPURE:	MOVB	AL,	-(SP)		;SAVE A COPY OF IT.
;FOR DEBUGGING AT ALL LEVELS.
;	MOV	20(SP),	STATUS	;RESTORE THE STATUS FOR ODT+TRACE-TRAP.
;	BIC	@PC,	20(SP)	;CLEAR TRACE BIT.
	CMPB	#070,	@SP		;TEST FOR FUNCTION CALL
	BLE	FLTDO			;SKIP ADDRESS FORMATION
	BIC	#-10,	AL		;LEAVE THE ADDRESS MODE BITS.
	MOVB	INADDR(AL),AL		;MAKE INDEX FOR ADDRESS FORMATION ROUTINES.
	ADD	AL,	PC		;SETUP "PTR" AS DATA POINTER.
FLTDO1:	MOVB	(PTR)+,AC		;GET THE DATA (AE=AC)
	MOVB	(PTR)+,AL		;LOW ORDER 8 BITS
	SWAB		AL		;LEFT SHIFT 8
	CLRB		AL		;...
	MOV	@PTR,	AH		;HIGH ORDER BYTE.
FLTDO:	MOVB	@SP,	TEMP		;LET'S TRY THOSE CODES
	MOV	PTR,	-(SP)		;SAVE POINTER FOR "PUT"
	MOV	HORD,	BH		;SETUP THE FLOATING AC
	MOV	LORD,	BL		;...
	CLRB		BL		;...
	ASRB		TEMP		;AGAIN.
	ASRB		TEMP		;MAKE AN EVEN TABLE ADDRESS
	BIC	#177761,TEMP		;CLEAR LEFT HALF
	JSR	PC,	@OPADDR(TEMP)	;DO THE OPERATION!
	JSR	PC,	NORF		;NORMALIZE IT.
	MOV	BL,	LORD		;SAVE RESULTS
	MOV	BH,	HORD		;...
FLTX:	CMP	(SP)+,	(SP)+		;DUMP THE POINTER AND THE CODES
	BR	PWREGS			;RESTORE REGISTERS AND RETURN



;"FPUT"

PUTF:	TST	(SP)+			;IGNORE RETURN FROM THIS ONE.
	MOV	@SP,	TEMP		;GET THE POINTER BACK
	MOV	BH,	@TEMP		;SAVE HIGH ORDER PART
	MOV	BE,	AH		;COPY "(BE)" FOR SAVE AND TESTS.
	SWAB	BL			;POSITION LOW ORDER BYTES.
	MOVB	BL,	-(TEMP)		;...
	MOVB	AH,	-(TEMP)		;SAVE HALF OF EXPONENT.
	BPL	.+4			;TEST FOR ALL SIGN BITS.
	COM	AH			;...
	SWAB	AH			;CHECK HIGH ORDER EXP.
	BEQ	FLTX			;OK=RETURN
	ERROR	12.			;NO=EXP OVER 38!


;ADDRESS MODES

INADDR:	.BYTE	EMDIR -FLTDO1		;ADDRESS FOLLOWS.
	.BYTE	FLTDO1-FLTDO1		;"PTR" CONTAINS ADDRESS.
	.BYTE	EMIND -FLTDO1		;(PTR)+4 IS  THE ADDRESS .
	.BYTE	EMTO  -FLTDO1		;STACK HAS DATA
	.BYTE	EMTHR -FLTDO1		;STACK HAS ADDRESS
	.BYTE	EMIME -FLTDO1		;DATA FOLLOWS
	.BYTE	EMREL -FLTDO1		;(TEMP) IS ADDRESS -
	.BYTE	NOP   -FLTDO1		;
					;BYTES ABOVE MUST BE LESS THAN 177.
					;
EMDIR:	MOV	@TEMP,	PTR		;TO THE PC1 AND PICKUP "X"
	ADD	#2,	16(SP)		;MOVE PC1 POINTER PAST DATA.
	BR	FLTDO1			;RETURN TO HANDLER.
EMIME:	ADD	#4,	16(SP)		;THEN
	MOV	TEMP,	PTR		;COPY ADDRESS OF DATA.
	BR	FLTDO1			;INDEX THROUGH THE STACK.
EMTO:	MOV	SP,	PTR		;INDEXES THROUGH THE STACK.
	ADD	#22,	PTR		;MOVE POINTER TO JOB.
	BR	FLTDO1			;GO USE IT.
EMIND:	CMP	(PTR)+,	(PTR)+		;AUTO INDEX THE POINTER
	MOV	PTR,	6(SP)		;COPY AND UPDATE PTR.
	BR	FLTDO1			;CONTINUE.
EMTHR:	MOV	22(SP), PTR		;USE JOB AS THE ADDRESS.
	BR	FLTDO1			;CONTINUE
EMREL:	ADD	@TEMP,	TEMP		;COMPUTE ABSOLUTE ADDRESS.
	MOV	TEMP,	PTR		;USE THAT RESULT.
	BR	EMDIR+2			;GO MOVE PC.


;POWER-FAIL

PWRDWN:	TST	WHOOPS			;CHECK FOR POWER-FAIL OR AUTO-RESTART.
	BNE	PWRUP			;IF NON-ZERO, THEN IT IS POWER-UP.
	MOV	%5,	-(SP)		;
	MOV	%4,	-(SP)		;SAVE 0-5.
	MOV	%3,	-(SP)		;
	MOV	%2,	-(SP)		;
	MOV	%1,	-(SP)		;
	MOV	%0,	-(SP)		;
	MOV	SP,	WHOOPS		;FINALLY SAVE THE STACK POINTER HIMSELF.**
NOP:	HALT				;STOP THE PROCESS; FALL-THROUGH FOR FAILSAFE.


;AUTO-RESTART

PWRUP:	MOV	WHOOPS,	SP		;RELOAD THE STACK POINTER
	CLR	WHOOPS			;RESET THE SWITCH
	PRINT+	'_			;PRINT POWERFAIL ACKNOWLEDGEMENT!
PWREGS:	MOV	(SP)+,	%0		;
	MOV	(SP)+,	%1		;
	MOV	(SP)+,	%2		;
	MOV	(SP)+,	%3		;
	MOV	(SP)+,	%4		;
	MOV	(SP)+,	%5		;RESUME PROCESS AND RESTORE THE STATUS.
PWRON:	RTI				;...

;FOR DEBUGGING WITH SINGLE STEP. (NOT REENTRANT)
;	TST	(SP)+			;MOVE POINTER
;	MOV	(SP)+,	STATUS		;RESTORE STATUS
;	MOV	-6(SP),	PC		;LET THIS INST BE EXECUTED, THEN TRAP.

;NORMALIZE RESULT AFTER DOING AN OPERATION.

NORF:	TST		BH		;TEST FOR ZERO
	BNE		NORM2		;OBVIOUSLY THERE SO SHIFT
	TST		BL		;CHECK LOW PART.	
	BEQ		NORMZ		;RESULT IS ZERO!
NORM2:	DEC		BE		;ROTATE LEFT FOR THE TEST
	ASL		BL		;TAKE CARE OF 2-DONE CASES:
	ROL		BH		;0.1XXX ;V=1
	BVS		NORMD		;1.0XXX ;V=1
	BPL		NORM2		;0.0 TEST
	BIT	#77777,	BH		;1.100,XXX-?
	BNE		NORM2		;NO!
	SEC				;YES=NEG. POWER OF 2
NORMD:	ROR		BH		;RESTORE TO PROPER PLACES.
	ROR		BL		;...
	INC		BE		;WON'T ROUND HERE.
	RTS		PC		;RETURN

GETF:	MOV	AC,	BE		;COPY THE OPERAND.
	MOV	AH,	BH
	MOV	AL,	BL
	RTS		PC

OPADDR:	GETF			;FLOATING POINT OPERATOR HANDLERS.
	ADDF
	SUBF
	DIVF
	MULF
	POWF
	PUTF
	NORX

FNADDR:	INTY			;FLOATING POINT FUNCTION HANDLERS
	INTF
	SGNF
	ABSF
	NEGF
	READF
	PRNTF
	INTZ

MULZ:	ADD	#6,	SP		;DUMP 'SIGN+COUNT+OLD RETURN'.
NORMZ:	CLR	BE
	CLR	BH
	CLR	BL
	RTS	PC




;THESE ATOMIC ARITHMETIC ELEMENTS ARE ENCODED
;ESPECIALLY FOR FOCAL-11

NORX:	MOVB	4(SP),	AC		;LOOK WHO'S HERE!
	BIC	#-10,	AC		;USE FUNCTION CODES TO
	ASL	AC			;FORM WORD ADDRESS IN TABLE AND
	JMP	@FNADDR(AC)		;JUMP TO THE FUNCTION PROCESSES.


;FUNDAMENTAL FLOATING POINT ROUTINES

SUBF:	NEG	AH			;SUBTRACT LOW ORDER.
	NEG	AL			;SUBTRACT LOW CARRY.
	SBC	AH			;FINISH W/O OVERFLOW CHECK

;ALIGNMENT OF A + B AND SHIFT RIGHT.
;DEFAULT CONDITION IF OUT OF RANGE IS
;SUCH THAT THE SMALLER IS ZEROED.

ADDF:	MOV	#BE,	TEMP		;CREATE EXP. POINTER.
	SUB	@TEMP,	AC		;COMPARE EXPONENTS
	BLE		ALIGNA		;AND SAVE COUNT.
	CMP	#31.,	AC		;TEST FOR POSSIBILITY THAT
	BLE		ALTAKA		;A IS TOO LARGE =USE A.
ALIGNB:	ASR		BH		;SHIFT DOUBLE B TO
	ROR		BL		;THE RIGHT AND ADD TO
	INC		@TEMP		;THE EXPONENT
	DEC		AC		;COUNT THE SHIFTS
	BGT		ALIGNB		;TEST FOR REPEAT (AC>0)
ALIGNA:	CMP	#-30.,	AC		;TEST RELATIVE SIZE
	BGE		ALGZA		;B IS TOO LARGE = EFFECTIVE ZERO A.
	ASR		AH		;SHIFT OVER
	ROR		AL		;...
	INC		AC		;COUNT SHIFTS
	BLE		.-6		;REPEAT UNTIL EXTRA 1 DONE.
	ASR		BH		;GIVE AN EXTRA SHIFT
	ROR		BL		;TO THE RESULT TO
	INC		@TEMP		;AVOID OVERFLOW. BUMP THE EXP.
	ADD	AL,	BL		;LEAVE RESULT IN B.
	ADC		BH		;ADD THE LOW ORDER CARRY
	ADD	AH,	BH		;FINISH W/O OVERFLOW CHECK
	BR	ALGZA			;RETURN FOR NORM, ETC.
					;
ALTAKA:	ADD	AC,	@TEMP		;CORRECT THE EXPONENT
	BR	GETF+4			;GO COPY THE DATA






;FINT (BE,BH,BL)=> (31.,BH)

INTF:	MOV	#BE,	AC		;CREATE EXP. POINTER
	TST		@AC		;MAKES B INTO AN
	BLE		INTZ		;INTEGER BUT LEAVES
INTG:	CMP	#31.,	@AC		;THE EXPONENT CORRECT.
	BLE		INTX		;NO CHANGE POSSIBLE NOW.
	ASR		BH		;BRING IN SIGN BIT LEFT.
	ROR		BL		;ROTATE DP UNTIL
	INC		@AC		;THE EXPONENT CONTAINS
	BR		INTG		;31 DECIMAL.
					;
INTZ:	JSR	PC,	NORMZ		;LEAVE ZERO RESULT
INTX:	MOV	BL,	8.(SP)		;COPY INTO THE COPY OF "AC"
INTY:	RTS		PC		;RETURN ONE MORE LEVEL

XABS:	FABS			;SIMPLE CALLS FOR SIMPLE FUNCTIONS
	RTS	PC

XITR:	MOV	HORD,	-(SP)		;SAVE SIGN
	FABS				;ABS.
	FINT
	TST	(SP)+
	BPL	.+4
	FNEG
	RTS	PC

XSGN:	FSGN
	RTS	PC

ZERODM:	ADD	#12,	SP		;DUMP R5,R5,PTR, CODES.
	BR	PWREGS			;GO RESTORE REGISTERS.
;THE FOLLOWING THREE PAGES CONTAIN
;"FMUL","FDIV","FSGN","FNEG","FABS", AND "FPOW".

;(2 WORD)*(2 WORD) MULTIPLY ROUTINE
;(TEMP,AC,BH,BL)*(AH,AL)=>(0,0,BH,BL;!AH,AL!)


MULF:	JSR	PC,	SIGN		;COMPUTE SIGN OF RESULT AND SAVE.
	BEQ		MULZ		;RESULT IS ZERO IF  A IS ZERO.
MDP0:	CLC				;CLEAR LEFT-MOST BIT.
	ROR		TEMP		;SHIFT 4 WORD RESULT
	ROR		AC		;RIGHT ONE PLACE.
	ROR		BH		;...
	ROR		BL		;...
	BCC		.+10		;NO CARRY=NO ADD
	ADD	AL,	AC		;UPDATE THE RESULT
	ADC		TEMP		;...
	ADD	AH,	TEMP		;...
	DEC		@SP		;COUNT BITS.
	BNE		MDP0		;REPEAT.
	ROR	TEMP			;PUT IT DOWN ONCE.
	ROR	AC			;...
SIGND:	MOV	TEMP,	BH		;COPY THE RESULT.
	MOV	AC,	BL		;...
	SUB	(SP)+,	(SP)+		;RESTORE THE SIGN OF
	BPL	BDIVX			;THE RESULT.
NEGX:	NEG		BH		;LEAVE A NEGATIVE RESULT
	NEG		BL		;...
	SBC		BH		;...
BDIVX:	TST	(SP)+			;DUMP OLD RETURN ADDRESS
	ADD	#1,	BL		;ROUND
	ADC	BH			;...
ALGZA:	MOV	BL,	AL		;COPY RESULT
	MOV	BH,	AH		;TO TEST SIZE.
	BPL	ALGZB			;TAKE ABSOLUTE VALUE.
	NEG	AH			;...
	NEG	AL			;...
	SBC	AH			;...
ALGZB:	BNE	.+6			;CHECK FOR HIGH ORDER NOT ZERO.
	SWAB	AL			;CHECK FOR LOW BYTE NOT ZERO,
	BEQ	NORMZ			;MAKE ALL ZERO RESULT.
	RTS		PC		;AND GET BACK TO THIS LEVEL.
					;
SGNF:	MOV	BH,	-(SP)		;SAVE HIGH ORDER PART.
SGN1:	MOV	#1,	BE		;CREATE A FLOATING ONE.
	MOV	#40000,	BH		;...
	CLR	BL			;...
	TST	@SP			;TEST THE SIGN OF STACK ENTRY.
	BR	NEGX-2			;GO TEST FOR RESULT.
					;
ABSF:	TST	BH			;TEST B AND PUT DUMMY ON STACK.
	BPL	SGNF-2			;GO USE OTHER BRANCH.
NEGF:	JSR	PC,	NEGX		;DOES NOT RETURN HERE;DUMMY ON STACK.
					;

;(4 WORD)/(2 WORD) DIVIDE ROUTINE
;(0,0,BH,BL)/(AH,AL)=> TEMP.00.BH,BL;!AH,AL!

DIVF:	NEG	AC			;TAKE DIFFERENCE OF EXPONENTS
	INC	AC			;PLUS ONE.
	JSR	PC,	SIGN		;MAKE SIGN OF RESULT ABS. VALS.
					;ADD TEMP+AC. ADD WITH COUNTER
	BEQ	DIVZER			;DIVIDE BY ZERO!
DIFL:	SUB	AL,	BL		;USE A TEMPORARY RESULT
	SBC	BH			;MAKE A TRIAL RUN
	CMP	AH,	BH		;CONTINUE THE ILLUSION
	BHIS	.+10			;COMPUTE INTERMEDIATE VALUE.
	SUB	AH,	BH		;BRANCH IF NO-ACTUAL CARRY.
	SEC				;NO-GO=UPDATE HIGH
	BR	.+10			;NO-GO=UPDATE LOW
	ADD	AL,	BL		;SET UP THE CARRY DATE FOR ROTATE
	ADC	BH			;SKIP
	CLC				;DUMP TRIAL RESULT+CLEAR CARRY
	ROL		AC		;ROTATE ALL
	ROL		TEMP		;ROTATE ALL
	ASL		BL		;ROTATE ALL
	ROL		BH		;ROTATE ALL
	DEC		@SP		;CONVERT
	BNE	DIFL			;REPEAT THE LOOP
	BR		SIGND		;GO DOCTOR THE SIGN
					;
DIVZER:	ERROR	14.			;DIVISION BY ZERO NOT ALLOWED.


;COMPUTE SIGN OF RESULT FOR MUL/DIV.

;ALSO SAVE THAT SIGN ON THE STACK.

SIGN:	ADD	AC,	BE	;COMPUTE EXPONENT
	MOV	BH,	-(SP)	;FIND SIGN OF RESULT
	BEQ	ZERODM		;RESULT IS ZERO IF B IS ZERO.
	BIC	#077777,@SP	;AS THE XOR OF ARGUMENT'S
	ADD	AH,	@SP	;SIGNS!
	CLR	TEMP		;CLEAR THE HIGH SIDE OF MUL-DIV
	CLR	AC		;...
	MOV	#31.,	-(SP)	;CREATE BIT COUNTER
	TST		BH	;TAKE ABSOLUTE VALUES
	BGE		.+10	;TAKE ABSOLUTE VALUES
	NEG		BH	;NEGATE B
	NEG		BL	;NEGATE B
	SBC		BH	;NEGATE B
	TST		AH	;TEST SECOND ARGUMENT
	BGE		.+10	;TEST SECOND ARGUMENT
	NEG		AH	;NEGATE A
	NEG		AL	;NEGATE A
	SBC		AH	;NEGATE A
	JMP	@4(SP)		;GO BACK 



;INTEGER EXPONENT CALCULATIONS

POWF1:	ASR	AH		;REDUCE TO INTEGER
	INC	AC		;COUNT SHIFTS
POWF:	CMP	#15.,	AC	;TEST FOR RANGE OF POWER
	BLO		FERRO	;OUT OF THE RANGE, FRACTIONAL
	BNE	POWF1		;GO TAKE INTEGER PART OF A.
	MOV	AH,	-(SP)	;SAVE THE COUNT (COULD BE ZERO)
	BMI	FERRO		;TEST FOR NEGATIVE POWER.
	BEQ	SGN1		;INITIALIZE MULTIPLICAND TO ONE
	MOV	BH,	-(SP)	;COPY THE BASE
	BEQ	ZERODM		;DON'T LET FMUL SEE ZERO!
	MOV	BE,	-(SP)	;SAVE EXPONENT OF THE BASE
	MOV	BL,	-(SP)	;INTO ARGUMENT POSITION
POWDO:	MOV	(SP)+,	AL	;RESTORE EXP. OF THE BASE
	MOV	(SP)+,	AC	;...
	MOV	(SP)+,	AH	;...
	DEC		@SP	;COUNT ON THE STACK.
	BEQ		BDIVX	;FINISHED!
	MOV	AH,	-(SP)	;SAVE EXP
	MOV	AC,	-(SP)	;...
	MOV	AL,	-(SP)	;...
	JSR	PC,	NORF	;NORMALIZE FOR ACCURACY.
	JSR	PC,	MULF	;MULTIPLY ONCE
	BR		POWDO	;REPEAT
				;
FERRO:	ERROR	15.		;NEGATIVE POWER!

;"FPRINT"

;FLOATING POINT OUTPUT CONVERSION FUNCTION
;[RE-ENTRANT!]
;FORMAT DATA IS TAKEN FROM "PTR"
;THIS PAGE PRODUCES A 7 DIGIT STRING PLUS LEADING ZERO.

PRNTF:	CLR	-(SP)			;OPEN PLACE FOR EXPONENT OF TEN.
	TST		BH		;TAKE THE ABSOLUTE VALUE
	BPL	FLOSGN			;PRINT SPACE FOR POSITIVE NUMBER.
	PRINT+	'-			;PRINT MINUS
	FNEG				;NEGATE THE NEGATIVE FLAC
	BR	.+4			;GO SCALE MODULO 10.
FLOSGN:	PRINT+	' ;			;PRINT THE SIGN
	MOV	#BE,	AC		;CREATE POINTER TO EXPONENT
	MOV	#8.,	TEMP		;SETUP 7D COUNTER
	MOV	#FLARG,	PTR		;SET TEMPORARY POINTER
	TST	@AC			;TEST RANGE FOR 0-4
	BEQ	FOGO4			;...
	INC	@SP			;COUNT A POWER OF TEN.
FOGO1:	CMP	@AC,	#4		;0<=X<10?
	BLT	FOGO2			;TAKE X MODULO 9
	BGT	.+12			;TEST SCALE
	CMPB	1+HORD,	#120		;...
	BLT	FOGO3			;...
	FMUL+IMMED			;NO, SCALE BY 10
PTEN:	063775,063146			;...
	BR	FOGO1-2			;RETURN TO TEST.
FOGO2:	TST	@AC			;TEST FOR EXPONENT > 0?
	BGE	FOGO3			;...
	DEC	@SP			;COUNT A POWER OF MINUS TEN.
	FMUL+IMMED			;SCALE BY 10.
TEN:	4,50000				;...
	BR	FOGO1			;RETURN TO TEST.
					;
FOGO3:	DEC	TEMP			;COUNT FIRST DIGIT
	CLR	-(SP)			;EXTRA HOLE?
FOGO4:	FPUT+IPTR			;ROUND LSB AND SAVE
	FINT				;GET THE DIGIT
	MOV	AC,	-(SP)		;STACK RESULTS
	FNEG				;REMOVE THE DIGIT
	FADD+IPTR			;...
	FMUL+DIRECT,TEN			;AND DIG OUT THE NEXT DIGIT.
	DEC	TEMP			;COUNT DIGITS
	BGT	FOGO4			;AND TRY AGAIN
	CLR	-(SP)			;OPEN SPACE FOR FORMAT DATA (VIA "PTR")
	MOVB	36(SP), @SP		;GET DECIMAL PART OF %X.0Y.
	MOV	#177400,-(SP)		;ADD CORRECTION FACTOR.
	FGET+FROM+STACK			;COMPUTE THE FRACTION
	FMUL+IMMED			;SCALE STEP NOS. BY
	16,062000			;100.X2^7
	FINT				;...
	CLOSE+STACK			;RESULT IS IN "AC"
;NO MORE CALLS TO FLOAT.

;COMPUTE THE L.S.D. POSITION

	MOV	SP,	R5		;START POINTER
	MOVB	35(SP), F		;COPY TOTAL DIGITS REQUESTED.
	MOV	20(SP),	E		;DIG UP THE NUMBER OF INTEGER DIGITS COMPUTED.
	CMP	F,	AC		;CORRECT FOR ILLOGICAL REQUESTS
	BGT	.+6			;OF DECIMALS > FIELD SIZE.
	MOV	F,	AC		;...
	DEC	AC			;AC=F-1
	MOV	AC,	CHAR		;USING E FORMAT?
	MOV	#6,	P		;INIT. SIX DIGIT OUTPUT.
	CMP	F,	E		;ENOUGH SPACE?
	BGE	.+4			;SKIP TO YES.
	CLR	F			;NO, USE E FORMAT.
	TST	F			;ASK QUESTION
	BEQ	TOF			;YES, MOVE AHEAD, AOK.
	ADD	E,	AC		;D+E
	CMP	F,	AC		;F < D+E?
	BGE	TOG			;I.E. ENOUGH SPACE?
	MOV	F,	AC		;ANY DIGITS VISIBLE?
TOG:	CMP	AC,	P		;MUST BE LESS THAN SIX.
	BGE	TOF			;KEEP 6 IN P.
	MOV	AC,	P		;YES, ROUND TO D+E
	BGE	TOF			;YES, USE P
	CLR	P			;NO, ROUND LEAD DIGIT.
TOF:	MOV	P,	AC		;SAVE NO. OF AVAILABLE DIGITS
	COM	P			;P = -(P+1) TO ROUND
	ASL	P			;COMPUTE WORD INDEX TO +5 ROUND.
	MOV	#16,	-(SP)		;INDEX FOUND
	ADD	R5,	@SP		;COMPUTE END ADDRESS
	ADD	@SP,	P		;COMPUTE +5 ROUND ADDRESS.

;ROUND THE B.C.D'S

TOT:	INC	@R5			;FUDGE FACTOR
	CMP	R5,	P		;SPECIAL ROUNDUP FACTOR
	BNE	TOR			;TEST FOR THERE ALREADY
	ADD	#5,	@R5		;ROUND BY +5
TOR:	CMP	#10.,	@R5		;OVERFLOW CAUSE
	BGT	TOS			;SKIP IF OK
	SUB	#10.,	(R5)+		;CORRECT FOR OVERFLOW
	BR	TOT			;AND CARRY
TOS:	TST	(R5)+			;BUMP THE POINTER.
	CMP	R5,	P		;TEST FOR ROUNDOFF START
	BEQ	TOR-4			;GO DO IT.
	CMP	@SP,	R5		;TEST FOR END.
	BGT	TOS			;REPEAT
	BEQ	.+4			;SKIP IF NO CARRY ONE.
	CMPB	(E)+,	(AC)+		;UPDATE "E" AND FIELD SIZE.
	PUSHJ	FPRNT			;CALL OUTPUT ROUTINE
	ADD	#24,	SP		;CORRECT STACK
	BR	FIGO4			;AND RETURN TO TOP LEVEL.

;FIXED POINT OUTPUT FORMAT

FPRNT:	MOV	F,	P		;USE LARGER OF F-D OR E
	BEQ	FLOUT			;TEST FOR FLOATING POINT FORMAT
	SUB	CHAR,	P		;COMPUTE INTEGER PLACES REQUESTED
	CMP	P,	E		;FORMAT OK?
	BGE	FPRNTP			;YES, GO DO IT.
	MOV	E,	P		;SHIFT DECIMAL POINT RIGHT
	CMP	E,	F		;BUT NOT TOO FAR!
	BGT	FLOUT			;GO USE "E" FORMAT ANYWAY.
FPRNTP:	CLR	CHAR			;0
	CMP	P,	E		;TEST DISTANCE TO DOT.
	BGT		FTRY		;GO LINE UP A DIGIT
	DEC	E			;COUNT DOWN INTEGER DIGITS
	DEC	AC			;COUNT DOWN STRING DATA.
	BLT	LTZERO			;PRINT TRAILING ZERO
	MOV	-(R5),	CHAR		;GET AN ACTUAL DIGIT
LTZERO:	PUSHJ	PRNT1			;OR A REAL DIGIT.
	DEC	F			;COUNT DOWN THE FIELD.
	BLE	DXIT			;BRANCH IF END OF DATA FORMAT.
	DEC	P			;COUNT DOWN DISTANCE TO DOT.
	BNE	FPRNTP			;THERE YET?
	PRINT+	'.			;YES
	BR	FPRNTP			;CONTINUE
					;
FTRY:	CMP	P,	#1		;PRINT AT LEAST 0
	BLE	LTZERO			;...
	MOV	#40-60,	CHAR		;OR A LEADING SPACE
	BR	LTZERO			;...

;FLOATING POINT OUTPUT FORMAT

FLOUT:	MOV	E,	-(SP)		;SAVE POWER OF TEN FOR LATER.
	CLR	E			;0.XXXX
	MOV	#1,	P		;...
	MOV	#7,	F		;FIELD SIZE
	PUSHJ		FPRNTP		;PRINT FIRST DIGIT GROUP
	PRINT+	'E			;E+-XXX
	MOV	(SP)+,	PTR		;LOOK AT EXPONENT AGAIN
	BGE	.+10			;GO PRINT SIGN.
	NEG		PTR		;CORRECT E TO ABSOLUTE VALUE
	PRINT+	'-			;PRINT SIGN.
	BR	PRNTP			;FALL INTO DIGIT PRINT ROUTINE.
	PRINT+	'+			;...
PRNTP:	DIGTST,	100.			;PRINT 2 OR 3 DIGITS
	CMPB	CHAR,	#60		;...
	BEQ	PRNT2			;IGNORE FIRST ZERO.
	PRINTC				;...
PRNT2:	DIGTST,	10.			;PRINT 2 DIGITS FOR SURE
	PRINTC				;...
	MOV	PTR,	CHAR		;PRINT LAST DIGIT
PRNT1:	ADD	#60,	CHAR		;...
	PRINTC				;...
DXIT:	POPJ				;AND RETURN.



;END OF OUTPUT CONVERSION ROUTINES


;"FREAD"

;FLOATING POINT INPUT CONVERSION FUNCTION
;[RE-ENTRANT]

READF:	MOV	14(SP),	AXOUT		;PROBLEM IN RE-ENTERING.
	PUSHJ		DECONV		;CONNECT FIRST DIGIT GROUP
	CLR	PTR			;START FRACTION COUNTER.
	CMPB	CHAR,	#'.		;DID IT END IN PERIOD?
	BNE		FIGO1		;NO, GO FINISH THE ANSWER
	PUSHJ		DECON1		;COUNT DIGITS AND APPEND RESULT.
FIGO1:	MOV	PTR,	-(SP)		;OPEN SPACE ON THE STACK FOR NO. OF DEC. DIGITS.
	BITB	#NALPHA,SWITCH		;FROM GETLN?
	BEQ	FIGO2			;YES, LEAVE
	CMPB	CHAR,	#'E		;DID IT END WITH "E"?
	BNE		FIGO2		;NO, GO EXIT
	FPUT+DIRECT,	FLARG		;YES, SAVE PRESENT RESULT
	GETC				;READ ON PAST THE 'E'.
	PUSHJ		DECONV		;READ EXPONENT
	TST	AC			;CORRECT FOR SIGN OF EXPONENT.
	BMI	.+4			;...
	FNEG				;...
	FINT				;MAKE AN INTEGER IN 'AC'
	ADD	AC,	@SP		;SAVE EXPONENT AND USE AS COUNTER
	FGET+DIRECT,	FLARG		;RECOVER VALUE OF DECIMAL FRACTION
FIGO2:	MOV	#PTEN,	PTR		;INITIALIZE CORRECTION POINTER
	MOV	(SP)+,	AC		;TEST THE SIGN OF THE EXPONENT
	BPL	FIGOE			;IF -,CORRECT BY *.10
	NEG	AC			;TAKE ABS. VAL. OF THE EXP COUNT.
	MOV	#TEN,	PTR		;IF +, CORRECT BY *10.
FIGOE:	DEC	AC			;DO THE CORRECTION.
	BLT	FIGO3			;LEAVE WHEN FINISHED.
	FMUL+IPTR			;CORRECT FLAC VIA POINTER ON THE STACK.
	BR	FIGOE			;REPEAT UNTILL EXPONENT COMPLETED.
					;
FIGO3:	MOV	CHAR,	16(SP)		;INTERNAL DATA=YES. COPY TERMINATING CHARACTER.
	MOV	AXOUT,	14(SP)		;COPY TEXT POINTER
FIGO4:	TST	(SP)+			;LEAVE VALUE
	JMP	FLTX			;TO BE RESTORED AT "PWREGS"



;CONVERT A GROUP OF NUMBERS.

DECONV:	FZER				;CLEAR INITIAL VALUE AND 'AC'
	CMPB	CHAR,	#201		;+?
	BEQ		DECON1		;YES
	CMPB	CHAR,	#202		;-?
	BNE		DECON1+2	;NO
	COM		AC		;YES-REVERSE SIGN
DECON1:	GETC				;GET NEXT CHARACTER
	TSTB		CHAR		;CHAR FOR 'TERMS'
	BMI		DXIT		;LEAVE ON THE TERMINATOR
	CMPB	CHAR,	#'.		;TEST FOR GROUP TERMINATOR
	BEQ		DXIT		;AND LEAVE IF FOUND
	SKPNON,	DETN			;CHECK FOR NUMBER
	BITB	#NALPHA,SWITCH		;TEST FOR ALPHA AS TERM.
	BEQ	DXIT			;CLEAR=YES.  IF =1 THEN CAN'T BE E-FORMAT EITHER.
	CMPB	CHAR,	#'E		;CHECK FOR SPECIAL FORMAT
	BEQ	DXIT			;...
	BIC	#-40,	CHAR		;CLEAR HIGH ORDER BITS OR "A-Z" ASCII CODES.
DECOY:	INC		PTR		;COUNT DIGITS
	MOV	CHAR,	-(SP)		;SAVE THIS DIGIT ON STACK
	MOV	#15.,	-(SP)		;LOAD INTEGER EXPONENT ONTO STACK
	FMUL+DIRECT,	TEN		;MULTIPLY  PRESENT VALUE BY 10
	FADD+FROM+STACK			;ADD IN NEW DIGIT
	CLOSE+STACK			;REMOVE ARG. FROM STACK.
	BR	DECON1			;GO BACK FOR MORE,
					;
DETN:	BIC	#-20,	CHAR		;USE BCD PART OF ASCII NUMBER.
	BR		DECOY		;GO USE THE DIGIT.

;"INCH" AND "OUTCH"

;USING 'INDEV' AND OUTDEV' FOR SYNCHRONOUS I/O.

XI33:	MOV	INDEV,	CHAR		;END BUFFER TO POINTER
	CMP	#PRS,	CHAR		;TEST FOR DEVICE
	BNE	KITH			;LOW SPEED
	TSTB	@CHAR			;WAIT FOR FLAG
	BPL	.-2			;WAIT FOR KEYBOARD DONE FLAG
	MOVB	2(CHAR),CHAR		;SAVE INPUT BUFFER
XI33X:	INC	@INDEV			;REQUEST NEXT
	RTS	R5			;RETURN FROM I/O DEVICE ROUTINE.

XOUT:	MOV	CHAR,	-(SP)		;SAVE DATA
	MOV	OUTDEV,	CHAR		;LOAD POINTER
	TSTB	@CHAR			;TEST FLAG
	BPL	.-2			;WAIT AND CHECK FOR CNTRL/C
	MOVB	@SP,	2(CHAR)		;OUTPUT DATA
	MOV	(SP)+,	CHAR		;RESET CHARACTER
	RTS	R5			;RETURN

INIT2:	ERROR	0.			;BEGIN

KITH:	MOV	@#KIN,	CHAR		;TEST FOR DATA READY.
	BMI	KITH			;WAIT FOR INTERRUPT
	COM	KIN			;RESET
	BR	XI33X			;RETURN

KINT:	MOV	@#TKS+2,-(SP)		;READ DATA; CLEAR DONE
	CMPB	#203,	@SP		;BREAK?
	BEQ	INIT2			;YES
	TST	KIN			;NO, ROOM?
	BMI	.+4			;YES
	ERROR	19.			;INPUT BUFFER OVERFLOW.
	MOV	(SP)+,	KIN		;SAVE DATA
	RTI				;CONTINUE

; *=PROGRAMMABLE I/O COMMAND. <OPTIONAL>

Z=IOLIST+IOLIST

IOFIX:	ASL	AC				;MAKE EVEN
	MOV	IOPATCH-Z(AC),	PTR		;GET PATCH ADDRESS
	MOV	IOGO-Z(AC),	@PTR		;STORE THE PATCH
	CMP	#PRS,		@PTR		;H.S.?
	BNE	IOQ				;NO
	BIT	#4200,		@(PTR)+		;YES, 'BUSY' OR 'DONE'?
	BNE	IOQ				;YES
	INC	@-(PTR)				;NO, SET READER ENABLE.
IOQ:	GETC					;LOOK AT NEXT TEXT CHAR.
PROGIO:	SORTC,IOLIST,IOFIX			;TEST
	JMP	PROC				;CONTINUE THE LINE.


IOLIST=.
.ASCII	"RKPTL"
.BYTE	0
.EVEN



IOGO=.
	PRS
	TKS
	PPS
	TPS
	LPS

IOPATCH=.
	INDEV
	INDEV
	OUTDEV
	OUTDEV
	OUTDEV
;***...



;SYMBOL TABLE TYPEOUT ROUTINE <OPTIONAL>

;USED BY *TYPE*ASK*
;VIA 'ATLIST'

TDUMP:	MOV	STARTV,	R5		;INIT POINTER
TDUMP1:	TST		@R5		;TEST FOR NULL ENTRY
	BNE		TDUMP2		;GO TYPE NAME, ETC.
	ADD	#10,	R5		;MOVE POINTER
TDUMP3:	CMP	R5,	BOTTOM		;TEST LIMITS
	BLO	TDUMP1			;TRY AGAIN
	TST	(SP)+			;BUMP STACK
	POPJ				;LEAVE *TYPE*ASK*
					;
TDUMP2:	MOVB	(R5)+,	CHAR		;READ FIRST LETTER OF NAME N
	PRINTC				;AND PRINT SAME
	MOVB	(R5)+,	CHAR		;READ SECOND LETTER
	PRINTC				;AND PRINT
	PRINT+	'(			;OPEN PARENTHESIS
	CLR	PTR			;CLEAR DATA WORD.
	BISB	(R5)+,	PTR		;COPY SUBSCRIPT
	JSR	PC,	PRNTP		;PRINT SUBSCRIPT DIGITS.
	PRINT+	', 			;COMMA
	CLR	PTR			;CLEAR DATA WORD.
	BISB	(R5)+,	PTR		;COPY LEFT-HAND BITS AND
	JSR	PC,	PRNTP		;PRINT SAME
	PRINT2,	")=			;CLOSE PARE
	MOV	R5,	PTR		;COPY POINTER.
	FGET+IPTR			;LOAD THE VALUE OF THE VARIABLE
	MOV	FISW,	PTR		;LOAD FORMAT DATA
	FPRINT				;PRINT CONTENT OF FLAC
	PRINT2,	CRLF			;PRINT CRLF AT END OF LINE
	CMP	(R5)+,	(R5)+		;MOVE POINTER TO NEXT ENTRY
	BR		TDUMP3		;CONTINUE THE SCAN

;RANDOM NUMBER GENERATOR <OPTIONAL>

;FRAN()


XRAN:	MOV	CHAR,	-(SP)		;SAVE NEXT CHARACTER
	MOV	#LSPR,	CHAR		;LOAD POINTER TO DATA.
	MOV	@CHAR,	AC		;COPY DATA
	ROL		AC		;R*2
	MOV	@CHAR,	TEMP		;
	ADD	AC,	TEMP		;R*3
	SWAB		TEMP		;LOW R*3
	CLRB		TEMP
	MOV	AC,	PTR
	SWAB		PTR		;LOW OF R*2
	CLRB		PTR
	ADD	@CHAR,	PTR		;R*2MOD2^8+R
	ADC		TEMP
	ROL		AC		;*4
	ADC		PTR
	ROL		AC
	ROL		@CHAR		;2*R PLUS BIT
	ADD	PTR,	@CHAR		;PLUS LOW, ETC.
	MOV	@CHAR,	-(SP)
	ROL	@SP
	ADD	@CHAR,	@SP
	ADD	TEMP,	@SP
	BIC	#100000,@SP		;USE POSITIVE RESULTS.
	MOV	@SP,	@CHAR		;SAVE HIGH RESULT.
	MOV	(SP)+,	HORD
	MOV	PTR,	LORD
	BR	XCHARG


;CHARACTER I/O FUNCTION <OPTIONAL>

;FCHR(-1):INPUT ASCII
;FCHR(FOO):OUTPUT ASCII

XCHR:	FINT				;FROM  INT OF ARG.
	MOV	CHAR,	-(SP)		;SAVE NEXT CHARACTER.
	MOV	AC,	CHAR		;PREPARE TO PRINT
	BMI	XCHR1			;BUT PERHAPS GO READ.
	OUTCH				;OUTPUT
XCHARG:	MOV	(SP)+,	CHAR		;RESTORE NEXT CHARACTER
	POPJ				;RETURN
XCHR1:	INCH				;LOOK FOR INPUT
	BIC	#-400,	CHAR		;8-BIT ASCII
	MOV	CHAR,	HORD		;SAVE RESULT
	MOV	#15.,	BE		;SET THE EXPONENT
	BR	XCHARG			;...





;EXECUTE USER FUNCTIONS!!  <OPTIONAL>

;SET Z=FNEW(ARG,LINENO)

XFNEW:	MOV	#XFGO,	-(SP)		;SAVE RETURN
	MOV	#100046,-(SP)		;VARIABLE "& ".
	CLR	-(SP)			;ZERO SUBSCRIPT
	JMP	GS1			;GO MAKE VARIABLE.
XFGO:	MOV	PTR,	-(SP)		;SAVE POINTER.
	FPUT+IPTR			;SAVE ARG.
	GETC				;MOVE PAST COMMA
	GETLN				;READ LINE/GROUP
	SPNOR				;MOVE TO TERMINATOR
	MOV	CHAR,	-(SP)		;SAVE LAST
	MOVB	#216,	CHAR		;LOAD TERMINATOR.
	PUSHJ	DO+2			;DO THE SUBROUTINE
	MOV	(SP)+,	CHAR		;RESTORE LAST R-PAR.
	MOV	(SP)+,	PTR		;DIG UP POINTER.
	FGET+IPTR			;RETRIEVE RESULT.
	POPJ				;RETURN.

;A/D CONVERTER FUNCTION FOR ADO1-11 <OPTIONAL>

;SET Z=FADC(GAIN,CHANNEL)

XADC:	FINT				;READ GAIN AND
	ASR	AC			;LOAD IT INTO THE AC POSITION.
	ROR	AC			;...
	ROR	AC			;...
	ROR	AC			;...
	MOV	AC,	-(SP)		;SAVE RESULT
	EVAL.X				;READ CHANNEL NUMBER.
	FINT				;MAKE IT AN INTEGER.
	BISB	AC,	1(SP)		;COMBINE THE BITS
	MOV	(SP)+,	ADCS		;LOAD INTO STATUS.
	FZER				;CLEAR 'FLAC' AND DELAY
	MOV	ADDB,	HORD		;READ RESULT.
	FMUL+IMMED,17-6,50000		;1/102.4
	POPJ				;RESULT IN VOLTS.

	ADCS=176770
	ADDB=176772

;SQUARE ROOT FUNCTION <OPTIONAL>

XSQT:	MOV	#BE,	R5
	MOV	#FLARG,	PTR
	OPEN+STACK			;SAVE VALUE
	FPUT+INTO+STACK			;FOR NEWTON'S METHOD
	TST	HORD			;TEST
	BPL	.+4			;FOR
	ERROR	17.			;IMAGINARY ROOTS.
	BEQ	SQUEND			;RESULT IS ZERO.
	MOVB	@R5,	@PTR		;TEST LOW
	ASRB	@PTR			;MAKE FIRST APPROX.
	ADCB	@PTR			;...
	MOV	#60320,	2(PTR)		;...
CLCU:	FGET+FROM+STACK			;MAKE SUCCESSIVE
	FDIV+IPTR			;APPROXIMATIONS.
	FADD+IPTR			;...
	DEC	@R5			;...
	CMPB	@PTR,	@R5		;EQUAL?
	BNE	ROOTGO			;NO, TRY AGAIN
	CMP	2(PTR),	HORD		;YES, TEST SOME MORE
	BNE	ROOTGO			;NO
	CMPB	1(PTR),	LORD+1		;LAST TEST
	BHIS	SQX			;...
ROOTGO:	FPUT+IPTR
	BR	CLCU
SQUEND:	CLR	BE
SQX:	CLOSE+STACK
	POPJ

;EXPERIMENTAL FUNCTION <OPTIONAL>

;FX( 1,BUSS. ADDR,0)			;READ
;FX( 0,BUSS. ADDR,DATA)			;"AND"
;FX(-1,BUSS. ADDR,DATA)			;LOAD

XEX:	MOV	HORD,	R5		;SAVE FUNCTION
	CLR	-(SP)			;START BUS ADDRESS
XEX2:	GETC				;MOVE ON.
	SPNOR				;IGNORE BLANKS
	CMPB	CHAR,	#214		;TEST FOR COMMA
	BEQ	XEX3			;LEAVE
	CMPB	#261,	CHAR		;TEST FOR ALPHA
	BLT	XEX2A			;USE EXPRESSION
	BIC	#-10,	CHAR		;
	ASL	@SP			;
	ASL	@SP			;
	ASL	@SP			;
	BIS	CHAR,	@SP		;
	BR		XEX2		;
					;
XEX2A:	EVAL.X				;READ ADDR. EXPRESSION.
	FINT				;
	MOV	AC,	@SP		;
XEX3:	MOV	R5,	-(SP)		;
	EVAL.X				;READ DATA
	FINT				;PUT INTEGER IN 'AC'
	MOV	(SP)+,	R5		;
	BMI	XEL			;
	BEQ	XET			;
	MOV	@(SP)+,	AC		;
	BR	XEXIT			;
					;
XEL:	CMP	#BUFBEG,@SP		;PROTECT FOCAL
	BLO	XEM			;...
	ERROR	13.			;DISALLOWED BUSS ADDRESS
XEM:	MOV	AC,	@(SP)+		;LOAD
	POPJ				;LEAVE
					;
XET:	BIS	@(SP)+,	R5		;LOGICAL "AND"
	COM	R5			;   "
	BIC	R5,	AC		;   "
XEXIT:	MOV	AC,	HORD		;SAVE RESULT
	MOV	#17,	BE		;...
	POPJ				;GO BACK TO FUNCTION CONTROL.
;FAST SINE,COSINE <OPTIONAL>

;BY R. MERRILL
;SMALL 51(10) WORDS
;SIN(X)=COS(P1/2-X)
;COS(4X)=8<COS(X)^4-COS(X)^2>+1
;COS(X)=1-X^2/2+X^4/24-X^6/720
;      =1-X^2*(1-X^2/12+X^4/360)/2
;      =1-X^2*(1-X^2*<1-X^2/30>/12)/2
;      =1+S*(1+S*<1+S/30>/12)/2

FSIN:	FNEG				;SIN(X)=COS(PI/2-X)
	FADD+IMMED			;...
	166001,	62207			;PI/2=1.570796
FCOS:	OPEN+STACK			;USE STACK AS TEMPORARY STORAGE
	CLR	PTR			;CLEAR COUNTER
	FPUT+INTO+STACK			;SAVE X
	FMUL+FROM+STACK			;TAKE X SQUARED.
	TST	BE			;X^2<125?
	BLT	FCOS2			;YES
	MOVB	@SP,	PTR		;COPY EXPONENT OF TWO
	MOVB	#-1,	@SP		;0 IF EVEN
	ASR	PTR			;FIND RESULT IF DIVIDED BY FOUR  (EXP-2).
	BCS	.+4			;=-1 IF ODD
	ASLB	@SP			;=-2 IF EVEN
	INC	PTR			;SET COUNTER
	FGET+FROM+STACK			;COPY RESULT
	FMUL+FROM+STACK			;S=-X^2
FCOS2:	FNEG				;...
	FPUT+INTO+STACK			;PUT S ON STACK.
	FDIV+IMMED			;TAKE FIRST FRACTION
		5,74000			;30
	FADD+DIRECT,FLTONE		;COMPUTE INNER EXPRESSION
	FDIV+IMMED			;...
		4,60000			;12
	FMUL+FROM+STACK			;FIND ( )
	FADD+DIRECT,FLTONE		;...
	DEC	BE			;DIVIDE BY TWO (EXP-1)
	FMUL+FROM+STACK			;COMPUTE LAST OF SERIES
FCOS4:	FADD+DIRECT,FLTONE		;...
	DEC	PTR			;COUNT "RECURSIONS"
	BLT	SQX			;LEAVE WHEN DONE.
	FPUT+INTO+STACK			;FIND COS^2
	FMUL+FROM+STACK			;...
	FPUT+INTO+STACK			;SAVE COS^2
	FMUL+FROM+STACK			;COS^4
	FSUB+FROM+STACK			;COS^4-COS^2
	ADD	#3,	BE		;MULTIPLY BY EIGHT.
	BR	FCOS4			;REPEAT
					;
FLTONE:		1,040000		;CONSTANT OF ONE.



BUFBEG=.				;BEGINNING OF TEXT BUFFER.


					;ONCE ONLY CODE.
INIT:	BIC	#277,	SP		;SET TO XX7500
	MOV	SP,	BOTTOM		;COPY
	MOV	STACKO+2,SP		;START STACK
	ERASEV				;CLEAR VARIABLE AREA.
	JMP	@#INIT2			;GO START



.END INIT

   